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COPYRIGHT (C) 1978 REGENTS OF THE UNIVERSITY OF CALIFORNIA. 
PERMISSION TO COPY OR DISTRIBUTE THIS SOFTWARE OR DOCUMEN- 
TATION IN HARD OR SOFT COPY GRANTED ONLY 3Y WRITTEN LICENSE 
OBTAINED FROM THE INSTITUTE FOR INFORMATION SYSTEMS, 
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(**** + ****************:*********************************************) 

PROGRAM PASCALSYSTEM; 

**************************************** ******** ) 
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*) 
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*) 
*) 
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*) 
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*) 
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************************************************) 



UCSD PASCAL OPERATING SYSTEM 

RELEASE LEVEL: 1,3 AUGUSTt 1977 

1.4 JANUARY, 1978 

1.5 SEPTEMBER, 1978 
II. FEBRUARY, 1978 BD 

WRITTEN BY ROGER T. SUMNER 
WINTER 1977 

INSTITUTE FOR INFORMATION SYSTEMS 
UC SAN DIEGO, LA JOLLA, CA 

KENNETH L. BOWLES, DIRECTOR 



CONST 



MMAXINT = 32767; (*MAXI 

MAX'JNIT = 12? (*MAXI 

MAXDIR = 77? (*MAX 

VIDLENG = 7; (*NUMB 

TIDLENG = 15; (*NUMB 

MAXSEG = 155 <*MAX 

FBLKSIZE = 512; (♦STAN 

DIR3LK = 25 (*DISK 

AGELIMIT = 300; <*MAX 

EOL = 13; (*END 

DLE = 16? (*BLAN 



MUM INTEGER VALUE*) 

MUM PHYSICAL UNIT ft FOR UREAD*) 

NUMBER OF ENTRIES IN A DIRECTORY*) 

ER OF CHARS IN A VOLUME ID*) 

ER OF CHARS IN TITLE ID*) 

CODE SEGMENT NUMBER*) 

DARD DISK BLOCK LENGTH*) 

ADDR OF DIRECTORY*) 
AGE FOR GDIRP...IN TICKS*) 
OF-LINE.. .ASCII CR*) 
K COMPRESSION CODE*) 
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TYPE 



NAM-;_LEN = 23; CLENGTH OF CONCATC VIDLENgi • : • ,TIDLENG ) 3 
FILl.LE;j - 11; C^AXIMUM fj OF NULLS IN FILLER] 



IORSLTWj = (IN0EKR0R,IBADBL0CKtI3ADUNITtIBADM0DEtlTIHE0UTt 
ILOSTUNlT.ILOSTFILEiIBADTlTLE.lNOROOMflNOUNIT, 
INOFlUE.lDUPFlLEtlNOTCLOSED.INOTOPEN«IBADFORMAT» 
ISTRGOVFL) ; 

(♦COMMAND STATES. ..SEE GETCMD*) 

CMDSTATE = < HALTINIT , DEBUGCALL , 

UPROGNOU.UPROGUOKtSYSPROG. 
COMPONLY,COMPAMDGO,COMPDEBUGf 
LlNKANDGOtLlNKDEBUG) ; 

(*CODE FILES USED IN GETCMD*) 

SYSFILE = (ASSMBLER, COMPILER ♦ EDITOR , FILER, LINKER) ; 

(♦ARCHIVAL INFO. ..THE DATE*) 

DATEREC = PACKED RECORD 

MONTH.* 0..12; (*0 IMPLIES DATE NOT MEANINGFUL*) 

DAY: 0..31; (*DAY OF MONTH*) 

year: 0..100 (*ioo is temp disk flag*) 



END (*DATEREC*) 



UNITNUM r 0..MAXUNIT; 
VID = STRINGCVIDLENG3; 



DIRRANGE = 0..MAXDIRJ 
TID = STRINGCTIDLENGD5 
FULL>ID = STRIiMGCNAME-LEND; 



(♦VOLUME TABLES*) 



(*DISK DIRECTORIES*) 



FILE.TA3LE = ARRAY CSYSFILEJ OF FULL_IO; 

FILEKIND = (UNTYPEDFlLE.r ^KFILE , CODEFILE » TEXTFILE , 



6 7 


■„> 


l : :: 


i 


33 





i:d 


i 


39 





i: * 


i 


90 





i:o 


l 


91 





i:d 


l 


92 


*J 


1 * i 

X * ^' 


l 


93 





i:j 


l 


91 





i:d 


l 


95 


p 


i:o 


l 


96 





i:d 


i 


97 





i:d 


i 


93 


3 


i:d 


i 


99 


3 


J. • u 


l 


100 





1 • r» 

J. • U< 


l 


101 





i:d 


i 


102 





i:d 


i 


103 





i:o 


l 


101 





i:d 


l 


105 





i:j 


l 


106 





i:d 


l 


107 





i:d 


l 


108 





i:d 


l 


109 





i:d 


l 


110 





i:d 


i 


111 





i:d 


i 


112 





1 . ", 


l 


113 





i:d 


l 


111 





i:o 


l 


115 





i:d 


l 


lib 





i:d 


l 


117 





i:d 


l 


118 





i:d 


l 


119 





i:d 


l 


120 





i:d 


l 


121 





i:d 


i 


122 





i:d 


i 


123 





i:o 


l 


124 





i:d 


l 


125 


o 


i:d 


l 


126 





lib 


l 


127 





i:o 


i 



IMFuFILl,DATAFIll,GRAFFILE,FOTOFIL£,SECUREDIR) ; 



DIRENTRY = PACKEu RECORD 

OFlRSTbLK; INTEGER; 

olastblk: integer; 
case dfkind: filekind 

iECUREDIR, 

untypedfile: c*only in 

(FILLER1 : Q..2048; 
DVID: VIO; 
DEOVBLK: INTEGER; 



(♦FIRST PHYSICAL DISK ADDR*) 
(♦POINTS AT BLOCK FOLLOWING*) 
OF 



DIRCO].. .VOLUME INFO*) 

CFOR DOWNWARD COMPATIBILITY , 13 BITS} 

(*NAME OF DISK VOLUME*) 

(♦LASTBLK OF VOLUME*) 



DNUMFILE3: DIRRANGE; (*NUM FILES IN DIR*) 

dloadtime: integer; (*time of last access*) 

DLASTBOOT: DATEREC); (*M0ST RECENT DATE SETTING*) 

xdskfile»codi:file,textfile»infofile, 
datafileigraffileiFotofile: 



END 



(FILLER2 : 0. ,102m CFOR 

status : 3q0lean; 
dtid: tid; 

dlastbyte: l.fblksize; 
daccess: daterec) 
(*direntry*) ; 



DOWNWARD COMPATIBILITY} 

CFOR FILER WILDCARDS!) 
(♦TITLE OF FILE*) 
(*NUM BYTES IN LAST BLOCK*) 
(♦LAST MODIFICATION DATE*) 



DIRP r ^DIRECTORY! 

DIRECTORY = ARRAY CDIRRANGE3 OF DIRENTRYS 

(*FILE INFORMATION*) 
CLOSETYPE = <CNOR1AL, CLOCK, CPURGE , CCRUNCH) 5 

WINQOWP = ^window; 

WINDOW = PACKED ARRAY CO. .03 OF CHAR; 

FI3P = TIB; 

FI3 = RECORD 

FWINDOW: WINDOWP; (♦USER WINDOW. ..F", USED BY GET-PUT*) 

feof.feoln: boolean; ' 

fstate: (fjandwtfneedchartfgotchar) ; 

FRECSIZE: INTEGER; (*i:g BYTES. . . = >BLOCKFILE, 1 = >CHARFILE* ) 
CASE FISOPEN: BOOLEAN OF L ' 

TRUE: (FISBLKD: BOOLEAN! (*FILE IS ON BLOCK DEVICE*) 
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END (*FIS*) 



funit: unitnum; (*PHYSICAL UNIT #♦) 
FVID: VIDJ (+VOLUME NAME*) 

FREPTCNTt (* U TIMES F" VALID W/O GET*) 

FNXTBLK, (*NEXT REL BLOCK TO 10*) 

FMAXBLK; INTEGER; (*MAX REL BLOCK ACCESSED*) 
FMODIFIED:BOOLEANj (*PLEASE SET NEW DATE IN CLOSE*) 
fheader: DIRENTRY; (*C0PY of DISK DIR ENTRY*) 
case fsoftbuf: boolean of (*DISK get-put STUFF*) 

TRUE: (FNXT3YTE.FMAXBYTE: INTEGER; 
F3UFCHNGD: BOOLEAN; 
F3UFFER: PACKED ARRAY CO . .FBLKSIZED OF CHAR)) 



(♦USER WORKFILE STUFF*) 



inforec = record 

symfibp,c0defi3p: fi3p; 
errsym.errblk.errnum: integer; 
slowterm, stupid: boolean; 
altmode: char; 
gotsym,gotcode: boolean; 

WORKVlD,SYMVIDtCODEVID: VID; 

worktid,symtid,codetid: tid 
end (*inf0rec*) ? 



(*W0RKFILES FOR SCRATCH*) 
(♦ERROR STUFF IN EDIT*) 
(*STUDENT PROGRAMMER ID!!*) 
(♦WASHOUT CHAR FOR COMPILER*) 
(♦TITLES ARE MEANINGFUL*) 
(♦PERMSCUR WORKFILE VOLUMES*) 
(♦PERMSCUR WORKFILES TITLE*) 



(*CODE SEGMENT LAYOUTS*) 



segra^ge = 0..maxseg; 
segdesc = record 

diskaodr: integer; 

codeleng: integer 
end uslgdesc*) ! 



(*REL BLK IN CODE...ABS 
(*# BYTES TO READ IN*) 



(♦DEBUGGER STUFFS) 



IN SYSCOM**) 



BYTERANGE = 0..255; 

TRICKARRAY = RECORD CMEMORY DIDDLING FOR EXECERRORH 

CASE BOOLEAN OF 

TRUE : (WORD : ARRAY CO,. 3 OF INTEGER); 
FALSE : (3YTE : PACKED ARRAY CO. .03 OF BYTERANGE) 
END; 
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■ s SZxP = * MSCw; 
rfSCw = RECORD 

STATLINK: MSCInlP; (*POI^TER 

dynlink: mscwp; upoimter 
msseg.msjtab: ''trickarray; 
msipc: integer; 
localdata: trickarray 

END (*MSCW*) ; 



(♦MARK STACK RECORD POINTER*) 



TO PARENT MSCW*) 
TO CALLER'S MSCW*) 



SYSCOMREC = RECORD 

IORSLT: IORSLTWD; 
XEQERR: INTEGER; 
sysunit: UNITNUM; 
8UGSTATE: INTEGER; 
gdikp: DIRP; 
LASTMP,STKBASEf B0M3P: 



(♦SYSTEM COMMUNICATION AREA*) 
(*SEE INTERPRETERS. ..NOTE *) 
(*THAT WE ASSUME BACKWARD *) 
(♦FIELD ALLOCATION IS DONE *) 

(♦RESULT OF LAST 10 CALL*) 
(♦REASON FOR EXECERROR CALL*) 
(♦PHYSICAL UNIT OF BOOTLOAD^) 
(♦DEBUGGER INFO*) 
(♦GLOBAL DIR POINTER.SEE VOLSEARCH*) 

mscwp; 



INTEGER; 

(♦WHERE XEQERR BLOWUP WAS*) 
(♦MORE DEBUGGER STUFF*) 
OF INTEGER? 

(♦DRIVERS PUT RETRY COUNTS*) 
.83 OF INTEGER; 



,33 



MEMTOPfSEG, JTAB: 
30MBIPC! INTEGER; 
HLTLINE: INTEGER; 
BRKPTS: ARRAY CO. 

retries: integer; 
expansion: array co 

HIGHTlMEiLOWTIME: INTEGER; 
MISCINFO; PACKED RECORD 

N03REAK»STUPID,SL0WTERMt 

HASXYCRT,HASLCCRT,HAS8510A,HASCLOCK: BOOLEAN; 

USERKIND: (NORMAL* AQUIZ» BOOKER. PQUIZM 

IS.FLIPT : BOOLEAN 
END; 

crttype: integer; 
crtctrl: packed record 

RLF,NDFS.ERASEEOL,ERASEEOS, HOME, ESCAPE: CHAR; 

backspace: char; 
fillcount: 0..255; 
cleapscreen. clearline: char; 

prefixed: PACKED ARRAY CO. .83 OF BOOLEAN 

END; 



210 

211 

212 

213 

214 

215 

216 

217 

218 

219 

220 

221 

222 

223 

224 

225 

226 

227 

228 

229 

230 

231 

232 

233 

234 

235 

236 

237 

238 

239 

240 

241 

242 

243 

244 

245 

246 

247 

248 

24 9 

250 



u 

1 

u 

u 





3 



































3 



















o 













:o 
:o 

• u 

: D 
:d 
:d 
:.d 
:o 
:o 
:d 
:d 

ID- 
ID 
ID 

:d 

ID 
ID 
ID 
ID 
ID 



1ID 

1ID 
1ID 
1ID 
1ID 
1ID 
1ID 
1ID 
1ID 
1ID 
1ID 
1ID 

i:d 

1ID 
1ID 

i:d 

1ID 

i:d 



l 
l 
l 
i 
l 
l 
l 
l 
l 
l 
l 
l 
l 
l 
l 
l 
l 
i 
i 
l 

2 

8 

54 

55 

55 

59 

67 

68 

69 

70 

111 

116 

122 

126 

126 

126 

126 

126 

126 

204 



VAR 



CRTINFOI PACKED RECORD 

WIDTH, HEIGHT! INTEGER; 

RIGHT, LEFT, DOWN, UP; CHAR5 

BADCH,CHARDEL, STOP, BREAK* FLUSH, EOF: CHAR; 

ALTM0DE,LINEDELI CHAR 5 

3ACKSPACE,ETX, PREFIX! CHAR; 

PREFIXED! PACKED ARRAY CO. .13] OF BOOLEAN 
END; 
SEGTABLE: ARRAY CSEGRANGE3 OF 
RECORD 

codeunit: unitnum; 
codedesc: segdesc 

END 
END (*SYSCOM*); 



MISCINFOREC 



= RECORD 

msyscom: 
end; 



SYSCOMREC 



syscomi '"syscomrec; 

gfilesi array co. .53 of fibp; 

userinfo: inforec5 

emptyheap: ^integer; 

inputfib,outputfib» 

systerm,swapfib: fibp; 

syvid.dkvid: vid; 

thedate: daterec; 

debuginfo: ^integer: 

state: cmdstate; 

pl: string; 

ipot: array co. .43 of integer; 

filler: stringcfill.lend; 

digits! set of •0 , .. , 9' 5 

unitable: array cunitnum3 of (*0 not used*) 

RECORD 

uvid: vid; (*volume id 
case uisblkd: boolean of 
true: (ueovslk: integer) 
end (*l!nitable*> ; 
filename : file_ta6le; 



(♦MAGIC PARAM...SET UP IN BOOT*) 
(♦GLOBAL FILES* 0=INPUT» 1=0UTPUT*) 
(♦WORK STUFF FOR COMPILER ETC*) 
(♦HEAP MARK FOR MEM MANAGING*) 
(♦CONSOLE FILES. ..GFILES ARE COPIES*) 
(♦CONTROL AND SWAPSPACE FILES*) 
(♦SYSUNIT VOLID & DEFAULT VOLlD*) 
(♦TODAY. ..SET IN FILER OR SIGN ON*) 
(♦DEBUGGERS GLOBAL INFO WHILE RUNIN*) 
(♦FOR GETCOMMAND*) 

(♦PROMPTLINE STRING. ..SEE PROMPT*) 
(♦INTEGER POWERS OF TEN*) 
(♦NULLS FOR CARRIAGE DELAYS) 



FOR UNIT*) 
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264 

2b4 

264 (* SYSTEvi PROCEDURE FORWARD DECLARATIONS *) 

264 (* THESE ARE ADDRESSED BY OBJECT CODE... *) 

2o4 (* DO MOT ^OVE WITHOUT CAREFJL THOUGHT *) 

264 

1 PROCEDURE EXECERROR; 

1 FORWARD; 

1 PROCEDURE FI,MIT(VAR FI FIb; WINDOw: WINDOWP; RECWORDSI INTEGER); 

*+ FORWARD; 

1 PROCEDURE FRESETtVAR FI FIB) 5 

2 FORWARD; 

1 PROCEDURE FOPENUAR FI FIB; VaR FTITLEI STRING; 

3 FOPENOLDl BOOLEAN; JUNK: FIBP); 
5 FORWARD 

1 PROCEDURE FCLOSE1VAR FI FIB; FTYPEI CLOSETYPE)! 
3 FORWARD 

1 PROCEDURE 

2 FORWARD 

1 PROCEDURE 

2 FORWARD 
1 PROCEDURE 
1 FORWARD 

3 FUNCTION 

4 FORWARD 

3 FUNCTION I 

4 FORWARD 
1 PROCEDURE 

3 FORWARD 
1 PROCEDURE 

4 FORWARD 
1 PROCEDURE 
1 FORWARD 
1 PROCEDURE 
1 FORWARD 
1 PROCEDURE 

3 FORWARD 
1 PROCEDURE 

4 FORWARD 
1 PROCEDURE 
4 FORWARD 



*) 



FGET(VAR F; FIB) ! 
FPUT(VAR F: FIB) ; 

xseek; 

EOF(VAR FI FIB): BOOLEAN; 

EOLNUAR F: FIB) I BOOLEAN; 

FREADINTIVAR F: FIB; VAR II INTEGER); 

FWRITEINT(VAR Fl FIB? ItRLENG: INTEGER)! 

XREADREAL; 

XWRITERCAL; 

FREADCHAR(VAK F: Fl3! VAR CHI CHAR); 

FWRITECHAR(VAR FI FIB; CH: CHAR; RLENG: INTEGER); 

FREADSTRING(VAR F: FI3; VAR S: STRING; SLENGI INTEGER); 
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1 P R OCEQLH£ FWRITESTRlfjC-CVAR Fl FI3; VAR S; STRING; RLENG: INTEGER); 
1 h U K W A >0 • ■ 

1 PROCEDURE FWRITEBYTE S (VAR F: FI3; VAR A: wlNDOUJ RLENG, ALENG: INTEGER); 
j FORWARD ; 

1 PROCEDURE FREADLMtVAR F: FIB); 

2 FORWARD; 

1 PROCEDURE FWRITELNCVAR F: FIB); 

2 FORWARD; 

1 PROCEDURE SCONCAT(VAR DEST.SRC* STRING! DESTLENG: INTEGER); 
1 FORWARD; 

1 PROCEDURE SINSERTCVAR SRC.OEST: STRING; DESTLENG, INSINX: INTEGER); 

FORWARD; 

1 PROCEDURE SCOPY(VAR SRCDESTJ STRING; SRCINX , COPYLENG! INTEGER); 

1 PROCEDURE SDELETE(VAR OEST: STRING! DELINX tDELLENG: INTEGER); 

1 FORWARD; 

3 FUNCTION SP0S(VAR TARGET, SRCC STRING)! INTEGER; 
5 FORWARD; 

3 FUNCTION FBLOCKIQtVAR F: FIB! VAR A: WINDOW! I: INTEGER! 

! _ nD11 Q nblocks,rblock: integer; doread: boolean): integer; 

9 FORWARD; 

1 PROCEDURE FGOTOXY(X,Y.* INTEGER); 

3 FORWARD; 

3 

3 (* NON FIXED FORWARD DECLARATIONS *) 
3 

3 FUNCTION \/OLSEARCH(VAR FVID: VID; LOOKHARD: BOOLEAN; 

5 VAR FDIR: DIRP): UNITNUM; 

6 FORWARD? 

1 PROCEDURE WRITEDIR(FUNIT: UNITNUM; FDIR: DIRP); 
3 FORWARD; 

? FLJ cnI 10 . dIRsearch <var ^tid: tid; findperm: boolean; fdir: dirp): dirrange; 

r UKW AKD < 

3 FUNCTION SCANTITLE(FTITLE: STRING; VAR FVID: VID; VAR FTID: TID! 

° _.. /flD VAR FSEGS: INTEGER; VAR FKIND: FILEKIND): BOOLEAN; 

1 PROCEDURE DELENTRYtFlNX: DIRRANGE; FDIR: DIRP); 
3 FORWARD; 

I PR ™ DU * E inse:ntrY( var fentry: direntry; finx: dirrange; fdir: dirp); 

*+ r Ok w AR D < 

1 PROCEDURE HOMECURSOR; 
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FORWARD 

procedure: 

FORWARD 
PROCEDURE 

FORWARD 
PROCEDURE 

FORWARD 
FUNCTION 

FORWARD 
FUNCTION 

FORWARD 
FUNCTION 

FORWARD 
PROCEDURE 

FORWARD 



clearscreen; 

clcarline; 

prompt; 
spacewait(flush: boolean): boolean; 

etcharifljsh: boolean): char; 
fetchdir(funit:unitnum> : boolean? 

command; 



c$i globals 1 
C$1 syssegs.a 1 

(*************************** *********************************,,,*****) 

<* *) 

(* COPYRIGHT (C) 1978 REGENTS OF THE UNIVERSITY OF CALIFORNIA. *) 

(* PERMISSION TO COPY OR DISTRIBUTE THIS SOFTWARE OR DOCUMEN- *) 

(* TATION IN HARD OR SOFT COPY GRANTED ONLY BY WRITTEN LICENSE *) 

(* OBTAINED FROM THE INSTITUTE FOR INFORMATION SYSTEMS. *) 

!* •» 

(************** *****************************************„****„<,„„„,*,,, j 

SEGMENT PROCEDURE USERPROGRAM { IMPUT , OUTPUT : FIBP)! 
BEGIN FWRITELNCSYSTERM") ; 

PL := t|\|0 USER PROGRAM* ; 

FWRlTESTRlNG(SYSTERM A »PLtO) 

END (*USERPROGRAM*) ; 

SEGMENT PROCEDURE DEBUGGER 5 
BEGIN FWRITELN(SYSTERM~) ; 

PL := »nO DEBUGGER IN SYSTEM*; 

FWRlTESTRlNGtSYSTERM^.PLf 0) 
END (*OE3UGGER*) ; 
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END (*IO ERRORS*) ; 
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15: S := 'PROGRAMMED 3KtAK- D D I f i T • 
END (*XE3 ERRORS*) ; 
WRITELW(OUTPUTtS) ; 

END (*PRlf g TERROR*) 5 

SEGMENT PROCEDURE INITIALIZE? 

VAR JUST300TED: BOOLEAN; LTlTLE: STR INGC 40 3 ; 
MONTHS: ARRAY CO.. 153 OF STRINGC33; 
STARTUP : BOOLEAN; 
ST^FILL: ARRAY C0..H99J OF INTEGER; 

procedure initsyscom; 
var title: string; 

f: file of miscinforec; 

procedure init_filler(Var filler : string); 

3EGIN 

WITH SYSCOM^.CRTCTRL DO 
BEGIN 

IF FILLCOUNT > FILL. LET THEN 

FILLCOUNT := FlLL.LETv; 
FILLERCO: := CHR(FILLCCJNT) ; 
F I LLCHAR (FILLER: ID. FILL COUNT, CHR(O)) ; 

end; 
end cof init. fillers; 

segln cof initsyscom] 

init-filler(filler) ; 
debuginfo := nil; 
ipotco: := 1; ipoTci: := id; ipctc2D := 100; 

IPOTC33 := 1000; IP0TC4J := 10000; DIGITS := C , , ..»9»3; 

WITH SYSCOM" DO 
BEGIN 

XEQERR := 0; IORSLT := IN0ERR0RJ 
3UGSTATE :=0 

END; 

title := •♦system. miscinfo* ; 

reseT( f, title »; 

if ioresult = oru(inoerror) then 

BEGIN 

IF NOT EOF( F i THEN 
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WITH SfSCOi\-~. 

•begin 

.'■1 ISC INFO 
CRTTYPE 
CRTCTRL 
CRTIWFO 



F~ 30 



:= MSYSCOM.MISCINFO; 
;= MSYSCOM. CRTTYPE? 
;= MSYSCOM.CRTCTRL! 
;= MSYSCOM.CRTINFOJ 
INIT_FILLEK(FILLER) ; 

end; 
CLOSE( Fi normal ) 
end; 
unitclear(i) (*give bios new soft characters for console*) 
end (+initsyscom*) ; 

procedure initunitable; 
VAR lu.mit: unitnum; 

loir: dirp; 

lfib : fib; 

f : sysfile; 

te'j|p_names : file.table; 

not.found : SET UF SYSFILE; 

PROCEDURE INIT_ENTRY(LUNIT : UNITNUM; UNIT.NAME : VID) 5 
BEGIN 

UNITCLEAR(LUNIT) « 

IF IORESULT = ORD(INOERROR) THEN 
UNITABLECLUNIT3.UVID := UNIT-NAME; 

END COF init,entryd; 

begin cof initunitablej 

filemamecassmblerj := • :system,assmbler'; 
fllefjameccompilerd := ' : system. compiler • ; 
filenameceditor3 := ". system. editor • ; 
file^jamecfilerj := » :system. filer* ; 
fileijameclinker] := »: system. linker • i 
temp„names := filename? 
not-found := cassmtjler . . linker]; 

FINlT(LFIBtNILi-l); 
FOR LUNIT := TO MAXUNIT DO 
WITH UNITABLECLUNIT] DO 

3EGIN 

uvid := *♦; 
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JlSBLKu := LUNIT IN C 4 , £ , 9. .123 ; 
IF UISELKO THEN 
u£GIM 

UEQVBLK := MMAXIIMT; 
UNITCLEAR(LUNIT) ; 

IF IORESULT = ORD(IfjOERROR) THEN 
IF FETCHDIR(LUNIT) then 
BEGIN 

UVID := SYSCOiVi A .GDIRP^C03,DVlD; 
IF LUNIT = SYSCOM*.SYSUNIT THEN 
BEGIN 

SYVIO := UVID; 

LTITLE := ••SYSTEM. STARTUP'S 
FOPENUFIB, LTITLE, TRUE. NIL); 
STARTUP := LFIB.FISOPEN? 
FCLOSE(LFIBtCNORMAL) ; 
END; 
FOR F := ASSMBLER TO LINKER DO 

IF (LUNIT = SYSCOM^.SYSUNIT) OR (F IN NOT_FOUND> THEN 

BEGIN 

LTITLE := CONCATCUVIDiTEMP.NAMESCF3)» 
FOPEN (LF IB. LTITLE » TRUE, NIL ){ 
IF LFIB.FISOPEN THEN 
BEGIN 

FlLE-MAfECF: := LTITLE; 
NOT.FOUND :r NOT-FOUND - CF3! 
END; 
FCLOSE(LFIB,CNORMAL) ; 
END COF IF (LUNIT ...3; 
END COF IF FETCHDIR .. 3 ; 
END COF IF UISBLKD .. 3! 
END COF WITH3; 
IF JUSTBOOTED THEN 
DKviD := SYVID; 

lunit := v0lsearch(syvid.false,ldir) ; 
if ldir = nil them 
halt; 

THEDatE := LDIR^COH.DLASTBOOT; 
INIT_ENTRY(1. 'CONSOLE') ; 
INIT_ENTRY(2«'SYSTERM») ; 
INI T, ENTRY (3, 'GRAPHIC ) ; 
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INlT_riMT*Y{fo, •PRINTER' ) \ 
lMlT_rf\|TRY(7, 'RENIN' ) ; 
lMT_Li\iTRY<8. 'REMOUT' ) ; 
END COF INITUNITABLED; 

PROCEDURE INITCHARSET; 

TYPE Ch|ARSET= ARRAY C32..1273 OF 

PACKED ARRAY CO. .93 OF 0..2555 

var i: integer; 

dotriton : boolean; 

trix: record case boolean of 

true: (charaddr: integer); 

FALSE: (CHARBUFP: rt CHAR) 

end; 
display: ARRAY CO.. 79,0. .193 OF integer; (*FOR TRITON*) 
CHARBUF: RECORD 

seti: CHARSET; 

fllleri: packed array co. .633 of char; 
set2; charset; 

filler2: packed array co. .633 of char? 
triton: array co. .63*0. .33 of integer 

end (*charbuf*) ; 
lfib: fib; 

BEGIN FlNIT(LFIBtNILt-l) 5 

LTITLE := »*SYSTEM. CHARSET'; 
FOPEN( LFIB. LTITLEt TRUE* NIL) ! 
IF LFI8.FIS0PEN then 
BEGIN 

UNITCLEAR(3); 

IF IORESULT = ORD(INOERROR) THEN 
BEGIN 

UNITWRITE(3»TRIX»123) ; 
wITH LFIB.FHEADER DO 
BEGIN 

DOTRITON := DLAST3LK-DFIRST3LK > 45 

UN I TRE AD < LF IB. FUNIT, CHARBUF* SI ZEoFt CHARBUF) .DFIRSTBLK) 

end; 
trix.charaudr := 512-8192; (*unibus trickyness ! * ) 

FOR I := 52 TO 127 DO 
BEGIN 

^OVERlGHT(CHAF T . SETlC 1 1 , TRIX .CHARBUFP^ . 10 ) ; 
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TRIX.CHARAODR : = T'-? IX . CHARADDR+16 
£ND; 
TRIX.CHARAODR := 512-6144; 
FOR I := 32 TO 127 DO 

BEGIN 

moveright(Charbuf.se:t2Cid,trix.charbufp' v »io) ; 

trix.charaodr := trix . charaddr+16 
end; 
if just300ted and dotritom and not startup then 
begin (*initialize display array*) 

fillcharc display, sizeof< display) to) ; 

for i := to 63 do 

moveleft (char3uf.tr i tone i d»displayc it 10 3i8) ; 

UNITWRlTE(3fDlSPLAYC-80 3,23) 
END ELSE 

UNITWRITE(3, DISPLAY, 7) ; 
END 
END 
ELSE 

SYSCOM*.MISCINFO.HAS8510A := FALSE; 
FCLOSE(LFIB,CNORMAL) 
END (*INITCHARSET*) 5 

PROCEDURE INITHEAP; 

VAR LWINDOW: WINDOWP' 

BEGIN (*BASIC FILE AND HEAP SETTUP*) 

SYSCOM A .GDIRP != NIL; (* MUST PRECEDE THE FIRST "NEW" EXECUTED *) 

NEW (SWAPFIB, TRUE, FALSE) ! FINIT ( SWAPFIB" »NILi -1 ) ; 

NEW(INPUTFIB,TRUE»FALSE) ! NEW(LWINDOW) ; 

FINIT(INPUTFIB% LWINDOW, 0) ; 

NEW(0UTPUTFI3»TRUEiFALSE) ; NEW(LWINDOW) ; 

FINIT(0UTPUTFIB A , LWINDOW, 0) 5 

NEW(SYSTERM, TRUE, FALSE) ; NEW(LWINDOW) 5 

FINIT<SYSTERM~, LWINDOW, 0) 5 

GFILESCO: := INPUTFIB? GFILE5C13 := OUTPUTFIB! 

WITH USERINFO DO 
BEGIN 

NEW (SYMF IBP, TRUE, FALSE) ! FINIT < SYMFIBP A t NIL, -1 ) ; 
NEWCCODEFIBP, TRUE, FALSE) ; FINITC CODEFIBP~»NIL« -1 ) 

eno; ^ 

MARKtEMPTYHEAP) XD 
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END ( *ir>jITHEAP*) \ 
PROCEOjNE If-JITWORKFILE! 

procedure try_opeMvar wqrk.fib : fib; first : full. id; var secvol : vid; 

var sec-name : tidj var flag : boolean); 
var ltitle : f'jll-io; 

BEGIM 

F0=>EN(W0RK_FI3. FIRST .TRUE. NIL) ; 
IF NOT WORK.FIB.FISOPEN THEN 
IF SEC-NAME <> •• THEN 
BEGIN 

LTITLE := CONCAT(SEC_VOL» •:•, SEC-NAME) ; 
FOPEN (WORK-FIB .LTITLE, TRUE 1 NIL) 5 
END? 
FLAG := WORK-FIB. FISOPEN! 
IF FLAG THEN 
3EGIN 

SEC-VOL := WORK-FIB. fvid; 
SEC-NAME := WORK-FIB. FHEADER.DTID 

end; 

FCLOSE(WORK-FIB.CNORMAL) ; 
END; COF TRY.OPEND 

BEGIN 

WITH USERINFO DO 

BEGIN (*INITIALUE WORK FILES ETC*) 

ERRNUM := 0; ERRBLK := 0; ERRSYM := 0; 
IF UUSTBOOTED THEN 
3EGIN 

symtid := ••; codetid : = ••; worktid := • »; 

symvid := syvid; codevid := syvid; workvid := syvid 

end; 
try-opentsymflbp", , *system.wrk.text» .symvid.symtid.gotsym) 5 
try_open(cooefiap~. , *system.wrk.code».codevid,codetid,gotcode) ; 
altmode := syscom*.crtinfo.altmode« 

SLOWTERM := SYSCONT.MISCINFO.SLOtfTERMj 
STUPID := SYSCOM^.MISCIMFO. STUPID? 

ENQ 
END {+INITWORKFILE*) 5 
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PROCEDURE INITFILES; 
3EGIN 

FCL0SE(SWAPFI8 A iCN0RMAU ; 
FCI_0SE(USERIMF0.SYMFI6P A »CN0RMAD 5 
FCLOsE(USERINFO.cOOEFIBP~,CMORMAU 5 

fclose(inpjtfib%cnorw|al) ; 
fclose<outputfib*,cl\jormal) ; 
ltitle := •console:*; 

FOPENKINPUTFIS^LTITLE, TRUE, NIL) ; 

FOPE,M(OUTPUTFIB^, LTITLE, TRUE, NIL); 

IF J'JSTBOOTED THEN 

BEGIN LTITLE := »SYSTER^: f ; 

F0PEN(SYSTERM^,LTITLE,TRJE1,NIL) 

end; 

GFIL£SC03 := INPUTFIB; 

gfilesci: := outputfib; 
GFILESC2] := systerm; 
SFILESC33 := NIL; GFILESC43 := NIL? 
END (*INITFILES*) ; 



GFILESC53 := NIL! 



BEGIN 
JUS 
MON 
WON 
MON 
MON 
MON 
MON 
MON 
MOM 
IF 
ELS 
INI 
INI 
INI 
INI 
CLE 
IF 

I 
WRI 
IF 



(♦INITIALIZE*) 



TBOOTED 
THSC 03 
THSC 23 
THSC 43 
THSC 63 
THSC 83 
THSC103 
THSC123 
THSC143 

justbooted 



= EMPTYHEAP = NIL 



»???• 

•FEB' 
•APR' 
•JUN« 
'AUG' 
•OCT' 
•DEC 
• ???• 
THEN 



MONTHS.C 13 
MONTHSC 33 
MONTHSC 53 
MONTHSC 73 
MONTHSC 93 
MONTHSC113 
MONTHSC133 
M0NTHSC153 
INITHEAP 



'JAN» 
•MAR* 
•MAY' 
•JUL 1 
• SEP' 
•NOV 
•???• 
•???• 



E RELEASE(EMPTYHEAP) ; 

TUNITABLE; CAND THE DATE, FILENAMES, *SYSTEM.STARTUP3 
TFILES; 

tsyscom; (*and some globals*) 

tworkfile; 

arscreen; 

SYSCOM A ,MISCINFO.HAS8510A THEN 

nitcharset; 

TEL M( OUTPUT) ; 
JUSTBOOTED THEN 
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is 



701 4 1:2 259 IF NOT STARTUP THEN 

702 <4 1:3 26.4 WITH SYSCO'-'i" DO 

703 4 114 270 -JEGIN 

704 <+ i:& 27C IF MISCINFO.HASXYCRT THEN 
70 5 4 i:6 26 C 3EGIN 

706 4 1:7 280 FGOTOXY(0*CRTINFO. HEIGHT DIV 3); 

707 4 1:7 291 IF FlLL-LEN > THEN 

708 4 i:8 296 WRIT£(OUTPUT. FILLER) I 

709 4 l:& 306 END; 

710 4 155 306 WRlTELNtOUTPUT, 'WELCOME •»SYVID«»» TO')? 

711 4 1:5 356 WRITELN(OUTPUT) ; 

712 4 1:5 362 WRITELN(OUTPUTi»U.C.S.D. PASCAL SYSTEM II.OMI 

713 4 1:5 408 WRITELN(OUTPUT) 5 

714 4 1:5 414 WITH THEDATE DO 

715 4 1:6 414 WRITE(OUTPUTt 'CURRENT DATE IS • .DAY. »-' ,MONTHSCMONTHD. '-' t YEAR) ; 

716 4 1:5 500 WRITELN(OUTPUT) ; 

717 4 1:4 506 END ELSE CNOTHING3 

718 4 i:i 508 ELSE 

719 4 1:2 510 WRITELN(0UTPUT» 'SYSTEM RE-INITIALIZED*) 

720 4 1:0 547 END ( *INITIALIZE*) 5 

721 4 1:0 564 

722 4 1:0 564 

723 4 HO 564 C$1 SYSSEGS.A 1 

723 4 HO 564 C$1 SYSSEGS.B 1 

724 4 110 564 

725 4 llO 564 ( *************************************************#*****♦****♦***** ) 

726 4 i:o 564 {* *) 

727 4 i:o 564 (* COPYRIGHT (C) 1978 REGENTS OF THE UNIVERSITY OF CALIFORNIA. *) 

728 4 1:0 564 (* PERMISSION TO COPY OR DISTRIBUTE THIS SOFTWARE OR DOCUMEN- *) 

729 4 1:0 564 (* TATION IN HARD OR SOFT COPY GRANTED ONLY BY WRITTEN LICENSE *) 

730 4 l:0 564 (* OBTAINED FROM THE INSTITUTE FOR INFORMATION SYSTEMS. *) 

731 4 1:0 564 (* *) 

732 4 110 564 (********************************************************#*********) 

733 4 ISO 564 

734 4 1:0 564 

735 5 l;D 3 SEGMENT FUNCTION GETCMD (LASTST: CMDSTATE): CMDSTaTE; 

736 5 i:D 4 CONST ASSEMONLY = LINKANDGO; 

737 5 1:0 4 TYPE STAT JS_ASSOCI ATE = ( FOUND.OK ♦ FOUND-BAD » NOT_FOUND ) 5 

738 5 i:D 4 VAR CH: CHAR; BADCMD: BOOLEAN; 

739 5 1:0 6 QOhjT-CARE : STATUS.ASSOCI ATE ! 

740 5 i:D 7 
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PROcEQjp.E RU.MwORKFILUOKTOLINK, RUNONLy: BOOLEAN); 
FORWARD; 

function sys.assoclate(sys-nayelsrsfile) boolean; 

forward; 

function associate(Title: string; oktolink, runonly.error.ok: boolean; 

var ass-status : st/\tus_ass0ciate > : boolean; 

LABEL l; 

var rslt: iorsltwd; lseg: segrange; 
segtbl: record 

diskinfo: array csegrangej of SEGDESC; 
segname: array csegrangej of 

packed array co. ,71 of char; 
segkind: array csegrangeh of. 

(l inked .hostseg.segproc.unitseg.seprtseg) j 
filler: array C0..1433 of integer 

END C SEGTBL 1 i 
BEGIN 

ASS-STATUS := NOT-FOUND; 
ASSOCIATE := false; 

FOPEN(USERINFO.CODEFIBP*» TITLE. TRUE. NIL) ; 
RSLT := SYSCOi«r.lORSLT; 
IF RSLT <> INOERROR THEN 
BEGIN 

IF ERROR-OK THEN 

IF RSLT = IBADTITLE THEN 

WRITE(OUTPUT, 'ILLEGAL FILE NAME') 
ELSE 

WRITEtOUTPUT. 'NO FILE », TITLE); 
GOTO 1 
END; 
ASS-STATUS := FOUNO_BAD; CUNTIL SHOWN OTHERWISE!! 
WITH USERINFO.SYSCONT DO 

IF CODEFIBP^.FHEADER.DFKIND <> CODEFILE THEN 
3EGIN 

»/RITE(OUTPuT.TITLE. • NOT CODE'); 
GOTO 1 
END 
ELSE iq 

BEGIN 
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UNI TPE4D(CODEF IBP*. FU\IIT» SEGTBL .SIZEOF (SEGTBL) . 

CjDEFlB a ~.FHEADER.DFIRSTBLK) ; 
IF IORESULT <> QRD(INOERROR) THEN 
BEGIN 

WRITE(OUTPUT»»BAD 8L0CK »0»)i 
GOTO 1 

end; 

WITH SEGTBL DO 

FOR LSEG := TO MAXSEG DO 

IF (SEGKINDCLSEGXLINKED) OR <SEGKINDCLSEG3>SEPRTSEG> THEN 
3EGIN C PRE 1.5 CODE. ..FIX UP! 1 

FILLCHAR(SEGKIND» SIZEOF ( SEGKIND) 1 ORD(LINKED) ) ! 
FILLCHAR(FILLER, SIZEOF ( FILLER ) . 0)J 
UNITWRITE(C0DEFIBP~.FUNIT, SEGTBLi SIZEOF ( SEGTBL ) . 
C0DEFI3P*.FHEADER.DFIRSTBLK) 
END; 
WITH SEGT3L DO 

FOR LSEG := TO MAXSEG DO 

IF SEGKINDCLSEGD <> LINKED THEN 
BEGIN 

IF OKTOLINK THEN 

BEGIN WRITELN( OUTPUT. 'LINKING...') ; 
FCLOSE<CODEFIBP~. CNORMAL)? 
IF SYS-ASSOCIATE(LINKER) THEN 
BEGIN 

IF RUNONLY THEN GETCMD := LINKANDGO 
ELSE GETCMD := LINKDEBUG; 
EXIT(GETCMD) 
END 
END 
ELSE 

IF NOT (LASTST IN CLINKANDGQ. LINKDEBUGD) THEN 
WRITE(0UTPUT.'MUST L(INK FIRST'); 
GOTO 1 

end; 
for lseg := 1 to maxseg do 

if (lseg = 1) or (lseg >= 7) then 
with segtableclsegd, segtbl. diskinfoclseg3 do 
begin codeunit := codeflbp'' .funit : 
codeuesc.codeleng := codeleng; 

CODEDESC.Dir "DDR := DISKADDR+ 
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CODEFIBP-.FHEADER.DFIRSTBLK 

FIND 
END ; 

ass-status := found-ok5 
associate := true; 

: fclosecuserinfo.codef i bp*,c normal) 
eno (+associate*) ; 

function sys_associatec(Sys_name:sysfile):booleanj; 
var vol : vid; 

title : tid; 

segs : integer; 

kind : filekind; 

lunit : unitnuh; 

ltitle : full.id; 

ass-status : status-associate; 

BEGIN 

SYS-ASSOCIATE := ASSOCIATE (FILENAMECSYS.NAME}, FALSE, FALSE, FALSE. ASS STATUS): 

IF ASS-STATUS = NOT.FOUND THEN 

IF SCANTITLE(FlLENAMECSYS.NAME3,VOL»TITLEtSEGS,KlND) THEN 
BEGIN 

LUNIT := 0; 

REPEAT 

LUNIT != LUNIT + II 

WITH UNITABLECLUNITD DO 

IF UISBLKD THEN 

BEGIN 

UVID := ••; 

IF FETCHDIR(LUNIT) THEN 

BEGIN 

uvid := SYSCOM A .GDIRP^COD.DVIDJ 
LTITLE := CONCATtUviDtM'tTITLE); 
IF LTITLE <> FILENAMECSYS-NAME3 THEN 

IF ASSOCIATE(LTlTLE,FALSE»FALSE, FALSE, ASS-STATUS) THEN 
FILENAMECSYS-NAME3 := LTITLE? 
END; 

end; c of if isblocked ...3 

UNTIL (LUNIT = MAXUMIT) OR (ASS-STATUS IN CFOUND-OK .FOUND-BAD]) I 
SYS-ASSOCIATE := ASS-STATUS = FOUND-OK; 
IF ASS_STATUS = NOT..FOUND THEN 

IF ASSOCIATE (FILENAMEC SYS.NAMED, FALSE, FALSE, TRUE, ASS-STATUS) THEN; 21 
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CJUST TO GET THE APPROPRIATE ERROR] 
END; COF IF SCANTITLE...3 
EMD! COF SYS-ASSOCIATED 

PROCEDURE STARTCOMPlLEtNEXTST: CMDSTATE); 
LA8EL l; 

var text.title. title: stringc 40 3 j 
i : integer; 
code.name : full. id; 
sys.type : sysfile; 

BEGIN 

IF NEXTST = ASSEMONLY THEN 

WRlTE(OUTPUT. 'ASSEMBLING 1 ) 
ELSE 

WRITE(0UTPUT» 'COMPILING' ) ; 
WRITELN(0UTPUT»',..') ; 
IF NEXTST = ASSEMONLY THEN 

SYS. TYPE := ASSMBLER 
ELSE 

SYs.TYPE := COMPILER? 
IF SYS-ASSOCIATE(SYS.TYPE) THEN 
WITH USERINFO DO 
BEGIN 

IF GOTSYM THEN 

TITLE := CONCAT(SYMVIDt»:»»SYMTID) 
ELSE 
BEGIN 

IF NEXTST = ASSEMONLY THEN 

WRITE<OUTPUT» 'ASSEMBLE') 
ELSE 

WRITE(0UTPUT» 'COMPILE'); 
WRITE(OUTPUT»' WHAT TEXT? »); 
READLNC INPUT* TEXT. TITLE); 
IF TEXT. TITLE = " THEN GOTO 1; 
TITLE := CONCAT(TEXT_TITLE, '.TEXT') ! 

end; 

F OPEN < S YMF IBP*» TITLEi TRUE* NIL) 5 
IF IORESULT <> ORD(INOERROR) THEN 
BEGIN 

WRITE(OUTPUT!'CAN"T FIND ♦, TITLE); 

GOTSYM := FALSE,' ^OTO 1 
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end; 

TITLE := CorjCAT<COPY< r lLENAMECSYS_TYPE],l, 

POS( • : • iFILENAMECSYS-TYPED) )» 'SYSTEM. SWAPDISK • ) ; 
F0PEN(SWAPFIB% TITLE , TRUE, NIL) ; 
CODE-NAME := **SYSTEM. ^RK.CODEC*3» ; 
IF NOT GOTSYM THEN 
BEGIN 

WRITE(QUTPUT, 'TO WHAT CODEFILE? *); 
REAQLN< INPUT, TITLE); 
IF TITLE <> " THEN 

IF TITLECm = SYSCOM~.CRTINFO.ALTMODE THEN 
GOTO 1 ELSE 

BEGIN CTREAT •$• AS A WILDCARDS 
I := POS(»$», TITLE) ; 
WHILE I <> DO 
BEGIN 

DELETE(TITLE,I.l); 

INSERT(COPY(TEXT.TITLE»l,LENGTH(TEXT.TITLE) ) , 
TITLEtl); 

I := POS(»$», TITLE)! 
END; 

IF TITLECLENGTHCTITLEH <> 'V THEN 

CODE-NAME := CONCATt TITLE, • .CODEC*]' ) ELSE 

code-name := title; 
end; 
end; 

F0PEN(C0DEFIBP% CODE-NAME, FALSE, NIL) 5 
IF IORESULT <> ORD(INOERROR) THEN 
BEGIN 

WRITE(OUTPUTi'CAN»»T OPEN ', CODE-NAME) ; 
GOTO 1 
END; 

errnum := o; errblk := o; errsym : = o; 
if nextst = assemonly then 

nextst := componly; 
getcmd := nextst? exit(getcmd) ; 
i: 
fclose<symfibp a ,cnormal) ; 

fcl0se(swapf1b a ,cn0rmal) 5 
end; 
end (*startcompile*) j 23 
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PrtOCEDjRE FINISHCOMPIIE; 
VAR RESULT : INTEGER; 
b E 5 1 r J 

FCLOsEtUSERINFO.sYMFIBP'tCNORMAL) 5 

FCL0$E(SwAPFI3"iCN0RMAL) J 

IF SrSCOM^.NlISClMFO.HASSSlOA THEN 

Uf\iITCLEAR(3) ; 
WITH USERINFO DO 

IF ERRNU.M > THEN 

BEGIN GOTCODE '•- FALSE; 

FCLOSE(CODEFlBP^tCPURGE) ; 
IF ERRBLK > THEN 

3EGIN CLEARSCREEN; WRITELN (OUTPUT ) 5 
IF SYS_ASSOClATE(EDITOR) THEN 

BEGIN GETCMD : = SYSPROG? EXIT(GETCMD) END 
END 
END 
ELSE 
BEGIN 

IF CODETID <> 'SYSTEM. WRK. CODE' THEN 
BEGIN 

CODEVID := CODEFIBP^.FVID; 
CODETID := C0DEFI3P A ,FHEADER.DTID; 
IF CODETID <> 'SYSTEM. WRK. CODE' THEN 
BEGIN 

WORKVID := CODEVID; 

IF LENGTH(CODETID) > 5 THEN 

IF C0PY(C0DETID,LENGTH(C0DETlD)-4,5) = '.CODE' THEN 
WORKTID := C0PY(C0DETIDtltLENGTH(C0DETID)-5) ; 

end; 
end; 
gotcode := true; 

cfib for codefile was closed in commands 
if lastst in ccompandgo, compdebug 1 then 
rjnw0rkfile<true» lastst = compandgo) 

END 
END (*FINISHC0'MPILE*) ; 

PROCEDURE EXECUTE; 

VAR TITLE: STRINGC255D; 
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BEGIN 

WRITE (OUTPUT. 'EXECUTE') ; 



" • ■> * • '_ 1 w u 1 r Ul 1 !_ A L ^ " I L ' I 1 

IF NOT SYSCO«".MiSCINFO,SLOWTERM THEN 

WRlTEfOUTPUT. • WHAT FILE'); 
WRITE(OUTPUT,'? »); READLN(TITLE) ; 
IF LENSTH(TITLE) > THEN 

BEGIN 

IF TITLECLENGTH(TITLE)3 = '.' THEN 

DELETE (TITLE 1 LENGTH (TITLE) tl) 
ELSE 

INSERT ('.CODE', TITLE, LENGTH ( TITLE )+l); 
IF ASSOCIATE(TITLt» FALSE, FALSE, TRUE, DONT.CARE) THEN 
BEGIN GETCMD := SYSPROG; EXIT(GETCMD) END 
END 
END (*EXECUTE*) ? 

PROCEDURE RUNWORKFILE; 
BEGIN 

WITH USERINFO DO 
IF GOTCODE THEN 
BEGIN 

CLEARSCREEN; 
WRITELN(OUTPUT); 

IF ASSOCIATE(CONCAT(CODEVID,»:',CODETlD), OKTOLINK, RUNONLY, TRUE, 
DONT.CARE) THEN 
BEGIN 

WRITELN{ OUTPUT, 'RUNNING. . . • ) { 
IF RUNONLY THEN 

GETCMD := SYSPROG 
ELSE 

GETCMD := DEBUGCALL! 
EXIT(GETCMD) 
END? 

IF NOT (LASTST IN CLINKANDGO, LlNKDEBUGD) THEN 
GOTCODE := FALSE 
END 
ELSE 

IF RUNONLY THEN 

STARTCOMPILE(COMPANDGO) 
ELSE 

STARTCOMPILE(COMPDEBUG) 25 
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END l ;<^"UORKFILE 3 ; 
r^EoIN ( *';-ETC.lu*) 

inputfi3'*.f'e0f := false; 
outpjtfi3~.feof := false; 

SYSTER-r.FLOF := false; 

gfileslou := inputfiu; gfilescid := outputfib; 
if lastst = haltinit then 
if associate( * *system, startup » , false , false . false , dont. care ) then 
begin clearscreen; 
getcmd := syspkog; exit(getcmd) 

EN L ;; 

if lastst in c componly , compandgo . compdebugd then 
finishcO'Jipile; 

IF LASTST IN C LINKaNDGO , LINKDEBUGD THEN 

RUNWQRKFILE(FALSE» LASTST = LINKANDGO); 
IF SYSCOM^.MISCINFO.USERKIND = AQUIZ THEN 
IF LASTST = HALTINIT THEN 

BEGIN LASTST := COMPANDGO; RUNWORKFILE( TRUE* TRUE) END 
ELSE 
BE&IN 

EMPTYHEAP := NIL; 

GETCMD := haltinit; 

EXlT(GETCMD) 

end; 
with userinfo do 

begin errnum := o? errblk := o; errsym := end; 
baqcmd := false; 

REPEAT 

PL : = 
•command: ecdit. r(un» f«ile» c(omp, hink. x(ecute, a(ssem, d(ebugt? cii.od* 
prompt; ch := getcharcbadcmo) ; clearscreen; 

IF Ch = '?• THEN 

BEGIN PL := 'COMMAND: U(SER RESTART. INITIALIZE* H(ALT»» 
PROMPT; CH := GETCHAR(BADCMD) ; CLEARSCREEN 

EN,;; 
BADCMD := NOT (CH IN C • E ' f • R • . B F « , • C » , • L • . • X » , ' A • , ' D • t • U ' » • I • » • H • . • ? ' 3 ) 5 
IF NOT BADCMD THEN 
CASE CH OF 

•E 1 : BEGIN WRITELN(0UT D UT) ; 

IF SYS-ASSOCI/ '(EDITOR) THEN 



f ? 9 5 1;£> 3£l7 3EGIN GETCMu := SYSPRO&; EXIT(GETCMD) END 

1070 5 1:4 374 end; 

1071 5 1!3 376 »F»: BEGIN WRITELN < OUTPUT ) ; 

J 072 D 1:b 3 ^2 IF SYS-ASSOCIATE(FILER) THEN 

1073 5 1:6 369 BEGIN &ETCMD := SYSPROG; EXIT(GETCMD) END 

l u7t * 5 i:<+ 39b END; 

1075 a 113 396 »L f : BEGIN ^RITELN ( OUTPUT .' LINKING ...') ; 

^ Q l° b 1:i5 ^24 IF SYS-ASSOCIATE(LINKER) THEN 

J?,; 5 1:6 H31 BEGIN GETCMD := SYSPROG; EXIT(GETCMD) END 

1078 5 1:4 438 END; 

1079 5 1:3 440 . x »: execute; 

1080 3 1!3 444 'C*: STARTCOMPILE(COMPONLY) ; 

1081 5 1:3 449 »A«: STARTCOMPILE(ASSEMONLY) ! 

1082 5 1:3 ^54 »u'5 IF LASTST <> UPROGNOU THEN 

1083 5 i:5 459 BEGIN 

1084 5 116 459 WRlTELN(OUTpUT, 'RESTARTING, ..') ; 

1085 5 1:6 438 GETCMD := SYSPROG; EXITCGETCMD) 

1086 5 1:5 495 END 

1087 5 1:4 495 EL SE 

JSSf = }'' b 497 BEGU! WR ITELN(OUTPUT)5 WRITE (OUTPUT, »U NOT ALLOWED') END? 

1089 5 1:3 528 'R'i'D': RUNWORKFILE { TRUE ♦ CH = 'R'); 

1090 5 1:3 538 'I','H': BEGIN 

1091 5 H5 538 GETCMD := HALTINIT; 

1092 5 115 539 IF CH = 'H» THEM 

1093 5 life 544 EMpTYHEAP := NIL? 

1094 5 1:5 548 EXIT(GETCMD) 

1095 5 1:4 552 END 

1096 5 1:3 552 END 

1097 5 111 610 UNTIL FALSE 

1098 5 1:0 610 END UGETCMD*) ; 

1099 5 1:0 634 C$1 SYSSEGS.3 3 

1099 5 i:o 634 C$1 SYSTEM. A 1 

1100 5 1:0 634 

1101 5 1:0 634 (*******************************************#*********♦********♦***) 

1102 5 l:c 63"+ (* A 

Unu I } 10 &34 U COPYRIGHT (C) 1978 REGENTS OF THE UNIVERSITY OF CALIFORNIA. *) 

iior ! 63i+ ( * PERMISSION TO COPY OR DISTRIBUTE THIS SOFTWARE OR DOCUMEN- *) 

Tin? c , ° 3<+ ( * TATI0N IN Ha R° 0R S0F T COPY GRANTED ONLY BY WRITTEN LICENSE *) 

"l° 5 1:0 634 ( * OBTAINED FROM THE INSTITUTE FOR INFORMATION SYSTEMS. *) 

1107 5 1:0 634 (* ,j 

1108 5 1:c 63 ^ I******************************************************************) 
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1109 b l;n 

mo 6 i:o ;-< 
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llll J ^ 1 PKOCECJR- ciXECERROK; 

JiJj C 44'^ t PROCEDJRE PRH.TL0CS; 

1115 i FJEGIN 

1116 IVll 11 WIT - ^SCOM-.SYSCCM". B 0MBP- 00 

1118 ^!3 .35 ^RlTF.(OUT.'UT.»Stt . , MSSES* . SYTEC 1 , 

1119 o 44:3 fai '' P * ''MSjTAB^.BYTECOJi 

1120 44:3 7k .. '' I# ,,: 

1121 44*4 Ij IF NISCINFO.IS-FLIPT THEN 
U22 p H':l 99 E J^TELW(MSIPC) 

i«J 44: : 2 L°9 Efr >ITELN.MSlPC - (ORQ(MSJTAB) - 2 - MS JTAB~. W ORDC -1 3 ) ) ; 

111! S Hit HI CND " F ""NTL0CS3. 

1127 o 2:0 BEGIN 

UP9 S ?:J ° WITH SYSCOM- DO 

1130 • 5 BEGIN 

1131 ?-a ,? IF x£Qe:rr = 4 THEN 

U32 t'A 11 3EGIN RE LEASE{EMPTYHEAP); 

1133 2 : 5 \% PL := '* STK OF L0W*'; 

1134 Q 2-5 u| ^ITWRITE(2.PLC1J,LENSTH(PL)); 

1135 2.-4 5? r ^IT(COH^AND) 

1137 ?'? ?? 30M3P*.MSIPC := B0M6IPC; 

1138 2*4 °i IF 3UGSTATE <> THEN 

1139 2-3 75 3EGIM DEBUGGER! XEQERR := END 
11^0 2*4 77 ELSE 

1141 2-5 II 3EalN RELEASE(EMPTYHEAP); 

1142 2-5 i,p 5FILESC03 := INPUTFIB; GFILESC13 ;= OUTPUTFIB- 

1143 2:5 113 ?2 M " PC '= INSULT; FWRITELN ( sYSTERm" > i 

Hit * VA H l -™^ OUT3, THEN 

11<fS ° 2:6 ^1 3EGIW 

1147 D 2'7 141 BEGIN 

1148 Q 2I7 i 7 7 WRITELN(OUTPUT,.EXEC ERR « •, XEQERR) 5 

1149 2-g 7p< IF XE ^ERR = 10 THEN 

WRlTEtOUTPUTtr ,30M3IPC) 



1150 9 Z', 2f«l END! 

1151 J 2 «5 201 PRINTLOCS; 

1152 j 2:b 2U3 IF NOT SPACEWA IT ( TRUE ) THEN EXIT ( COMMAND) 

1153 2:4 215 r f jO 

1154 u 2:2 215 END 

1155 ° 2:0 215 END (*EXECERROR*) ? 

1156 G 2:& 230 

1157 45:D 5 FUNCTION CHECKDEL < CH : CHAR? VAR SINX: INTEGER)! BOOLEAN; 
1155 45.-0 BEGIN CHECKDEL := FALSE; 

1159 1) 45:i 3 WITH SYSCOM^,CRTCTRL DO 

1160 45:2 13 BEGIN 

1161 45:3 13 IF CH = CRTINFO.LINEDEL THEN 

1162 45.*4 23 BEGIN CHECKDEL := TRUE; 

f " I H\l ft IF BACKSPACE = CHR(O)) OR (ERASEEOL = CHR(O)) THEN 

1164 45:6 45 BEGIN SINX := 1; 

1165 45:7 48 WRITELN(OUTPUT»»<DEL») 

1166 45:6 68 END 

1167 45:5 68 ELSE 

1168 45:6 70 BEGIN 

1169 45:7 70 WHILE SINX > 1 DO 

117? n a^i? It BEGIN SINX := SIN *-l; WRITE(OUTPUT, BACKSPACE) END? 

,V-,\ I 7Z 9? WRITE(OUTPUT.ESCAPE.ERASEEOL) 

1172 45:6 121 END 

1173 45:4 121 END; 

1174 45:3 121 IF CH = CRTINFO.CHARDEL THEN 

1175 45:4 131 3EGIN CHECKDEL := TRUE! 

1176 45:5 134 IF SINX > 1 THEN 

J;,! ° 45:6 1Jf0 BEGIN SINX := SINX-1J 

7i-7q n "I 5 '* 7 lif6 IF BACKSPACE = CHR(O) THEN 

Jfl« 2 ,! !8 15S IF CRTINFO.CHARDEL < • ' THEN 

1180 45:9 166 WRITE ( OUTPUT .»_' > 

JJoi 2 !*? :8 1?tf ELSE <*ASSUME PRINTABLE*) 

1182 45:7 176 ELSE 

1183 45:8 178 BEGIN 

Hit S IV.l JZ 8 IF CRTINFO.CHARDEL <> BACKSPACE THEN 

11*' 2 tl'° 193 WRITE(OUTPUT, BACKSPACE) J 

111? till 227 ^WRlTEtOUTPUT,. •, BACKSPACE) 

1188 4556 227 END 

1189 45:5 227 ELSE 

1190 45:6 229 IF CRTINFO.CHARDEL = BACKSPACE THEN 29 
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WRITE ( QUTPUT i ' ») 

,:nd 

END 
END (*CHrcKD£.L*) ; 

PROCEDURE PUTPREFIXED(WHICH:If\|TEGER; COMMANDCHAR : CHAR ) ! 
BEGIN 

WITH SYSCO'T DO 

IF CQMMAMOCHAR <> CHR(0) THEN 
BEGIN 

XF crtctrl.prefixedcwhich: THEN 

WRITEtOUTPUTiCRTCTRL. ESCAPE) 5 
jJRIT£(OUTPUT, COMMANDCHAR) ; 
IF FILL_LEN>0 THEN 

WRITE(OUTPUTtFILLER) 5 

END; 

end; 

procedure homecurscrj 

BEGIN 

PUTPREFiXED(4tSYSC0M' N .CRTCTRL.H0ME) ! 
END (*HOMECURSOR*) ; 

PROCEDURE clearscreen; 
BEGIN HOMECURSOR; 

WITH SYSCOM~,CRTCTRL DO 
SEGlfJ 

unitclear(3) ; 

if eraseeos <> chr(o) then 
putprefixed(3terasee0s) 

ELSE 

PUTPREFIXED(6tCLEARSCREEN) 
END 
END UCLEARSCREEN*) ; 

PROCEDURE CLEARLINE; 
3EGIN 

PUTPREfiXE0(2iSYSCQM~.CRTCTRL.ERASEE0L) 

END (*CLEARLINE*) ! 



1232 u 39 :o 1 PROCEDURE PROMPT; 

1233 u 39 :o i yAR i: INTEGER; 

1234 39 :o G BEGIN HO*IECURSOR 5 

1235 39:i 2 WITH SYSCOM* DO 

1236 39:2 7 SEGlM 

1237 39:3 7 CLEARLINE; 

1238 39:3 9 IF MlSC INFO. SLOWTERM THEN 

1239 39:4 17 BEGIN 

1240 39:5 17 I := SCAN(LENGTH(PL) ,=•: »,PLC13) J 

1241 39:5 33 IF I <> LENGTH(PL) THEN PLCOD := CHR(I+1) 

1242 39:4 49 lND 

1243 C 39:2 50 END? 

1244 U 39:i 50 WRITE ( OUTPUT , PL ) 

1245 3910 60 END UPRqmPT*) ; 

1246 39:0 72 

1247 29:D 1 PROCEDURE FGOTOXY < *X , Y : INTEGER*); 

1248 2910 BEGIN (*ASSUME DATA MEDIA*) 

1249 29!1 WITH SYSCOM* .CRTINFO DO 

1250 29:2 7 3EGIN 

1251 29:3 7 IF X < THEN X := 0! 

1252 29:3 15 IF X > WIDTH THEN X := WIDTH? 

1253 29:3 25 IF Y < THEN Y := 01 

1254 29:3 33 IF y > HEIGHT THEN Y .*= HEIGHT 

1255 29:2 39 END? 

1256 29:i 43 WRITE< OUTPUT, CHR ( 30 ) tCHR { X+32 ), CHR ( Y+32 ) ) 

1257 29:0 71 END (*GOTOXY*) ; 

1258 29:0 84 

1259 «fi:D 3 FUNCTION GETCHAR ( *FLUSH; BOOLEAN*); 

1260 4i:D 4 VAR CH; CHAR; 

1261 «U:o BEGIN 

1262 4i:i o IF FLUSH THEN UNITCLEAR ( 1 ) ; 

1263 4i:i 6 IF INPUTFIB^.FEOF THEN EXIT ( COMMAND ) ; 
126<+ 41:1 16 INPUTFIB^.FSTATE := FNEEDCHAR; 

1265 4i:i 23 READ(INPUT,CH); 

1266 4l:i 3i if (CH >= »A«) AND (CH <= »ZM THEN 

1267 41:2 40 • CH := CHR (ORD ( CH ) -ORD ( • A ♦ ) +ORD ( • A • ) ) ; 

1268 41.-1 47 GETCHAR := CH 

1269 41:0 47 END (*GETCHAR*) ; 

1270 41:0 62 

1271 40:D 3 FUNCTION SPACEWAIT ( *FLUSH: BOOLEAN*); _ 

1272 40:D 4 VAR CH; CHAR; 31 
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2LGIM 
REPEAT 

WRlTtlOUTPUT, 'TYPE <SPACE>' ) ; 

IF MOT SYSCOM^.wilSCINFO.SLO/iTLRM THEN 

WRITE (OUTPUT i • TO CONTINUE'); 
CH := GETCHAR(FLUSH) ; 
IF NOT EOLN( INPUT) THEN 

WRlTELN(OUTPUT) ; 
CLEARLINE 
UNTIL CH =••) OR (CH = SYSCOM A . CRTINFO. ALTMODE ) ; 
SPACEI^AIT := CH <> • • 
END (*SPACEWAIT*) J 

FUNCTION SCANTITLE(*FTITLE: STRING? VAR FVID: VID? VAR FTID: TIDj 

var fsegs: integer; var fkind: FILEKIND*); 
var i»rejrack: integer; ch: char; ok: boolean; 
begin 
fvid := ••; ftid := ••; 
FSEGS := o; FKIND := untypedfile; 

SCANTITLE := FALSE; I := 1? 
WHILE I <= LENGTH(FTITLE) DO 
BEGIN CH := FTITLECID; 

IF cH <= • • THEN DELETE(FTITLE»I,1) 
ELSE 
3EGIN 

IF (CH >- 'AM AND (CH <= »Z») THEN 

FTITLECID := CHR(ORD(CH)-ORD( »A» )+ORD( *A» ) ) ; 

I := i+i 

END 

end; 
if length(ftitle) > then 

BEGIM 

IF FTITLEC13 = •*• THEN 

BEGIN FVID := SYVID; DELETE ( FTITLE . 1 . 1 ) END; 
I := POSCMiFTITLE) ; 
IF I <= 1 THEN 
BEGIN 

IF LENGTH(FVID) = THEN FVID := DKVID; 
IF I = 1 THEN DELETE< r TITLE,l,l) 

ELSE 
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IF 1-1 <= VIDLLNG THEN 
3EGIN 

FVID := COPY(FTITLEtltI-l)i 
DELETE(FTlTLEtlil) 

end; 
if length(fvid) > then 

3EGIN 

I := POSCc'tFTITLE) ; 
IF I > THEN I := 1-1 
ELSE I := LENGTH(FTITLE); 
IF I <= TIDLENG THEN 
BEGIN 

IF I > THEN 

BEGIN FTID := COPY ( FTITLE , 1 , I ) ! DELETE ( FTITLE* 1 , I ) END; 
IF LENGTH(FTITLE) = THEN OK := TRUE 
ELSE 

BEGIN OK := FALSE; 

RBRACK := POS(»D», FTITLE); 
IF RBRACK = 2 THEN OK := TRUE 
ELSE 

IF RBRACK > 2 THEN 

BEGIN OK := TRUE! I := 25 
REPEAT CH := FTlTLECn? 
IF CH IN DIGITS THEN 

FSEGS := FSEGS*10+(ORD(CH)-ORD(»0»)) 

ELSE ok := false; 
i := i+i 

UNTIL (I = RBRACK) OR NOT OK; 
IF (I = 3) AND (RBRACK = 3) THEN 
IF FTITLECI-1D = •*• THEN 

BEGIN FSEGS ;= -1; OK := TRUE END 
END 
END; 
SCANTITLE := OK; 

IF OK AND (LENGTH(FTID) > 5) THEN 
BEGIN 

FTITLE := C0PY(FTID»LENGTH(FTlD)-4,5); 

IF FTITLE = '.TEXT* THEN FKIND := TEXTFILE 

ELSE 

IF FTITLE = ••CODE 1 THEN FKIND := CODEFILE 

ELSE 
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1355 33:1 477 IF FTITLE = '.BACK' THEN FKIND := TEXTFILE 

1356 33:i 452 ELSE 

1357 j 33.V2 436 IF FTITLE = '.INFO' THEN FKIND : = INFOFILE 

1358 33:2 511 ELSE 

1359 33:3 515 IF FTITLE = '.GRAF' THEN FKIND := GRAFFILE 

1360 33:3 530 ELSE 

1361 33:4 534 IF FTITLE = '.FOTO' THEN FKIND := FOTOFILE 

1362 33:8 549 END 

1363 33:6 551 END 

1364 33:4 551 END 

1365 33:2 551 END 

1366 33:0 551 END ( *SCANTI TLE* ) 5 

1367 3 33:0 576 

1368 33:0 576 (* VOLUME AND DIRECTORY HANDLERS *) 

1369 33:0 576 

1370 42:D 3 FUNCTION FETCHDIRC ( FUNIT: UNITNUM): BOOLEAN!]; 

1371 42:D 4 VAR LlNX: DIRRANGE; OK: BOOLEAN; HNOW! INTEGER; 

1372 12:0 BEGIN FETCHDIR := FALSE; 

1373 4211 3 WITH SYSCOM A ,UNITABLECFUNIT3 00 

1374 42:2 16 BEGIN (*READ IN AND VALIDATE DIR*) 

1375 42!3 16 IF GDIRP = NIL THEN NEW(GDIRP); 

1376 42:3 30 UNlTREAD(FUNlT,GDIRP A tSIZEOF(DIRECTORY)tDlRBLK) ; 

1377 42:3 41 OK := IORSLT = INOERROR; 

1378 42:3 47 IF OK THEN 

1379 42:4 50 WITH GDIRP A C03 DO 

1380 42:5 57 BEGIN OK : = FALSE; <*CHECK OUT DIR*) 

1381 42:6 60 IF (DFIRSTBLK = 0) AND 

1382 42:6 64 ( ( MISC INFO. USERKIND=BOOKER ) 

1383 42:6 72 OR ( < MISCINFO.USERKIND IN Z AQUlZtPQUIZ : > AND < DFKIND=SECUREDIR) 

1384 42:6 90 CR ( ( MISCINFO. USERKIND=N0RMAL) AND ( DFKIND=UNTYPEDFILE ) ) ) 

1385 42:6 109 THEN 

1386 42:7 112 IF (LENGTH(DVID) > 0) AND ( LENGTH( DVID ) <= VIDLENG) AND 

1387 42:7 127 (DNUMFILES >= 0) AND (DNUMFILES <= MAXDIR) THEN 

1388 42:8 141 BEGIN OK := TRUE; (*SO FAR SO GOOD*) 

1389 4219 144 IF DVID <> UVID THEN 

1390 42:0 152 BEGIN (*NEW VOLUME IN UNIT. .. CAREFUL* ) 

1391 42U 152 LINX := 15 

1392 42:i 155 WHILE LINX <= DNUMFILES DO 

1393 42:2 162 WITH GDIRP^CLINX 3 DO 

1394 42:3 169 IF (LENGTH(DTID) <= 0) OR 

1395 ^2:3 176 f -NGTH(DTID) > TIDLENG) OR 



J«7 ° lol* J?** (DLAST3LK < DFIRSTBLK) OR 

1393 " ^:t J^ (DLAST3YTE > FBLKSIZE) OR 

"" r aol^ (OLASTBYTE <= 0) OR 

1400 ll't f?S (DACCESS.YEAR >= 100) THEN 

1^01 o 42!3 223 - B - GIN ° K := FALSE; D ELENTRY(LINX,GDIRP) END 

\ll\ n ^J 225 U LINX := LINX+ll 

1403 42!1 232 IF N0T 0K rHEN 

1405 n if!? !v 3EGIN ( *' 1UST HAVE 8EEN CHANGED. ..WRITEIT*) 

! , n I Ih UrjlTWRITE<FUNlT,GDIRP-\ 

1407 lUl ,5 <DNUMFILES+1>*SIZE0F(0IRENTRY),DIRBLK); 

1408 J ^l 253 EN g K ' = I0RSLT = IN0ERR0R 

1409 42:0 257 E ND 

1410 42:8 257 END; 

1411 42:6 257 IF OK THEN 

ittf? 2 aoil ?!2 BEGIN UVID := DVID; UEOVBLK := DEOVBLK; 

1413 42.8 272 TIME < HNOW , DLOAQTIME ) 

1414 42:7 279 END 

1415 42:5 279 END; 

1416 42:3 279 FETCHDIR := OK; 

1417 42:3 282 IF NOT OK THEN 

\l\l 2 t f2: ' + 286 BEGIN UVID : = "' DEOVBLK := MMAXINT; 

1419 42:5 299 RELEASE(GDIRP) ; GDlRP := NIL 

1420 42:4 307 END 

1421 42:2 309 END 

1422 42.-0 309 END <*FETCHDIR*) ; 

1423 42:0 328 

1424 3i:D 1 PROCEDURE WRITEDIR ( *FUNIT: UNITNUM; FDIR: DIRP*); 

: ° *i:d 3 var HNowtLrgow: integer; ok: boolean; lde: direntry; 

1H«J6 3i:o BEGIN 

1427 3i:i WITH UNlTABLECFUNljD.FDlR^C 03 DO 

All S? ! 1:2 lt+ 8EGIN 0K ; = (UVI ° = DVID) AND ((DFKIND = UNTYPEDFILE) OR 

tu^n ? ;7!f 31 (DFKIND = SECUREDIR)); 

143J 31:3 *q. if OK THEN 

\ll\ ° 31;4 4? 3EGIN TIME(HNOW,LNOW); 

till ? \Y\l 53 OK := (LNOW-ULOADTIME <= AGELIMIT) AND 

,llt ? H 63 ((LMQW-DLOADTIME) >= 0) AND 

7a*- ! »:i- 72 SYSCO^.MISCINFO.HASCLOCKJ 

143a 31 : a 83 IF NOT OK THEN 

143o 3i:& 37 3EGIN ( *NO CLOCK OR TOO OLD*) 
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115 


1443 
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17 
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119 
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17 


134 


1447 





31 


17 


140 
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16 


173 
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1455 
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:o 
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3 


1459 





30 


ID 


6 


1460 





30 


10 





1461 





30 


11 


6 


1462 





30 


11 


12 


1463 





30 


12 


19 


1464 





30 


3 


19 


1465 





30. 
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5 
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1469 
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LJ;-JIT!^„J(f"J,nIT»LDIiSlZLOF( JIREMTRY) tDIRESLK) ; 



T 1~ M 



.^ISULT = ORjd'yOERRUR) TH^i 



jk :. Ovid = lDE.dvid; 
if ok then 

dEGIN (* ft 'E GUESS ALL IS SAFE . . . WRITEIT* ) 

DFIRSTBLK := 05 (*DIRTY FIX FOR YALOE BUGS*) 

UI\iITwRlTE(FUNIT.FDIR /N i 

(DNUMFILES+1)*SIZE0F(DIRENTRY) iDIRBLK) 5 
OK != IORESULT = ORD ( INOERROR ) ; 

IF DLASTBLK = 10 THEN (+REDUNDANT AFTERTHOUGHT*) 
UNITWRITE(FUNIT.FDIR~. 

(DNUMFILES+1)*SIZE0F(DIRENTRY) .6) \ 
IF OK THEN TlME(HNOW»OLOADTIME) 
END 

end; 
if not ok then 

3EGIN UVID := "J UEOVBLK := MMAXINT END 
END 
END (*WRIT£DIR*) ; 

FUNCTION yOLSEARCH(*VAR FVID: VXD; LOOKHARD: BOOLEAN; VAR FDIR: DIRP*)5 

var lunit: unitnum; okiPHysunit: boolean; HNOWtLNOw: integer; 
begin volsearch := 0; fdir := nil! 
ok := false; physunit := false; 
if length(fvid) > then 

BEGIN 

IF (FVIDC13 = '#•) AND ( LENGTH(FVID) > 1) THEN 
3EGIN OK 1= TRUE; 

lunit := 0; hnow : = 2; 

REPEAT 

IF FVIDCHNOW3 IN DIGITS THEN 

LUNIT := LUNIT*10+ORD(FVIDCHNOW3)-ORD( 'OM 
ELSE OK := false; 
hnow 1= hnow+1 
until (hnow > length(f\/id) ) or not ok5 
physunit := ok and (lunit > 0) and (lunit <= maxunit) 
end; 
if not physunit then 
begin ok := false; lunit := maxunit; 

REPEAT 
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121 
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30:1 


132 


1484 
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149 
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170 
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176 


1491 
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185 
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30:4 
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1506 
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30:6 
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1508 





30:7 


259 


1509 





30:4 


265 


1510 





30:3 


270 


1511 





30:2 


278 


1512 





30:1 


281 


1513 





30:2 


284 


1514 
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292 


1515 





30:4 


295 


1516 





30:4 


306 


1517 
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317 


1518 
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OK := FVID = UNITABLECLUNITJ.UVIO; 
IF NOT OK THEN LUNIT 1= LJNIT-1 
UNTIL OK OR (LUNIT = 0) 

END 

end; 
if ok then 
if unitableclunit3.uisblkd then 
with syscom* do 
begin ok := false; usee if gdlrp is good*) 
if gdirp <> nil then 

IF FVID = GDlRP^COa.DVID THEN 
BEGIN TIME(HN0W,LN0W) ; 

OK := LNOW-GDIRP^COD.DLOADTIME <= AGELIMIT 
END? 
IF NOT OK THEN 

BEGIN OK := PHYSUNIT; 

IF FETCHDIR(LUNIT) THEN 
IF NOT PHYSUNIT THEN 

OK := FVID = GOIRP^COa.DVlD 
ELSE 
ELSE 

OK := IORESULT = ORD ( INOERROR) ;CRELY ON IORESULT FROM FETCHDIR3 
END 
END; 
IF NOT OK AND LOOKHARD THEN 

BEGIN LUNIT := MAXUNIT; (*CHECK EACH DISK UNIT*) 
REPEAT 

WITH UNITABLECLUNIT3 DO 
IF UISBLKD THEN 

IF FETCHDIR(LUNIT) THEN 
OK := FVID s UVID; 

if not ok then lunit := lunit-1 
until ok or (lunit = 0) 
end; 
if ok then 
with unitableclunitj do 
begin volsearch := lunit! 
if length(uvid) > then fvid := uvid5 
if uisblkd and (syscom*. gdirp <> nil) then 
begin fdir := syscom*. gdirp ; 

flME(HNOW«FDIR"C0 3,DLOADTIME) 
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1543 
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1544 
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1545 





32:6 


1546 
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1547 
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34:d 


1552 





34:0 


1553 





34:i 


1554 





34:2 


1555 





34:3 


1556 





34:4 


1557 





34:3 


1558 





-^4:3 



534 ENO 

33'4 ENJ 

334 E.MO UVOLSEARCH*) i 

352 

352 

352 

352 CSI SYSTEM. A 1 

352 C3I SYSTEM. 3 1 

352 

352 I******************************************************************) 

352 (* *) 

352 (* COPYRIGHT (C) 1978 REGENTS OF THE UNIVERSITY OF CALIFORNIA. *) 

352 (* PERMISSION TO COPY OR DISTRIBUTE THIS SOFTWARE OR DOCUMEN- *) 

352 (* TATION IN HARD OR SOFT COPY GRANTED ONLY BY WRITTEN LICENSE *) 

352 <* OBTAINED FROM THE INSTITUTE FOR INFORMATION SYSTEMS. *) 

352 U *> 

352 (******************************************************************) 

352 

352 

3 FUNCTION DIRSEARCH(*VAR FTID: TIDi FINDPERM: BOOLEAN; FDIR: DIRP*); 

6 var i: dirrange; found: boolean; 

begin dirsearch := o; found := false; i := i; 

9 WHILE (I <= FDIR*C03»DNUMFILES) AND NOT FOUND DO 

22 BEGIN 

22 WITH FDIR^CIJ DO 

28 IF DTID = FTID THEN 

36 IF FINDPERM = ( DACCESS. YEAR <> 100) THEN 
49 3EGIN DIRSEARCH := I; FOUND := TRUE END; 

55 I := 1+1 

56 END 

60 END UDlRSEARCH*) ? 
76 

1 PROCEDURE delentryufinx: DIRRANGE! FDIR: DIRP*); 
3 var i: dirrange; 

BEGIN 

WITH FDIR*C03 DO 

6 BEGIN 

6 FOR I ;= FINX TO DNUMFILES-1 DO 

21 FDIR*CI3 := FDlR^Cl+135 

40 FDlR^CDNUMFILESDtDTID := "; 

53 DNUMFILES := DNUMFILES-; 



1559 a 34:2 59 Ehio 

1560 34:g 62 END . (*QEl_fNTRY*) ; 

1561 34 :o 76 

1562 35: j l PROCEDURE INSENTR Y ( *VAR FENTRY: DIRENTRY; FINXI DlRRANGE; FDIR: DIRP*); 

1563 35:0 4 VAR I: DIRRANGE; 

1564 o 35:o o begin 

1565 35:i WITH FDlR^CO] DO 

1566 35:2 6 BEGIN 

1567 35:3 6 FOR I := DNUMFILES DOWNTO FINX DO 

1568 35:4 19 FDlR"CI + 13 := FDlR*d3; 

1569 35:3 38 FDlR*CFINX !1 := FENTRY; 

1570 3513 45 DNUMFILES := DNUMFILES+1 

1571 35:2 51 END 

1572 35!0 54 END (*INSENTRY*) ; 

1573 35:0 68 

1574 47:D 3 FUNCTION ENTERTEMP ( VAR FTID: TID; FSEGS: INTEGER; 

*ll* ° n tf7:D 5 fkind: filekind; fdir: dirp): dirrange; 

1576 H7:D 7 VAR I t LASTI , DINX, SINX: DIRRANGE? RTllISH: BOOLEAN? 

1577 H7:D 12 SSEGS: INTEGER; LOE: DIRENTRY? 

1578 47:D 26 

}lll 2 !* 8:D X PROCEDURE FINDMAX(CURINX: DIRRANGE? FIRSTOPENiNEXTUSED: INTEGER)? 

1580 48:D 4 VAR FREEAREA! INTEGER? 

1581 48:0 BEGIN 

1582 48:i FREEAREA := NEXTUSED-FIRSTOPEN 5 

1583 48:i 5 IF FrEEArEA > FSEGS THEN 

1584 48:2 10 BESIN 

1585 48:3 10 SINX := DINX; SSEGS := FSEGS? 

1586 48:3 16 DINX := CURINX? FSEGS := FREEAREA 

1587 48:2 19 END 

1588 48:i 22 ELSE 

1589 48:2 24 IF FREEAREA > SSEGS THEN 

1590 48:3 29 BEGIN SSEGS ;= FREEAREA? SINX := CURINX END 

1591 48:0 35 END (*FINDNIAX*) ? 

1592 48:0 48 

1593 47:0 BEGIN ( *ENTERTEMP* ) 

1594 47:i o DINX := 0? LASTI := FDIR^C 3, DNUMFILES ? 

1595 47:i 11 SINX := 0? SSEGS := 0? 

1596 47:i 17 IF FSEGS <= THEN 

1597 47:2 22 BEGIN RTllISH := FSEGS < 0? 

1598 47:3 27 FOR I := 1 TO LASTI DO 

1599 47:4 39 FINDMAX ( I , FDIR"C I-13.DLASTBLK .FDIR^C I D.DFIRSTBLK) ? 39 
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47:3 


ol 


FI:JD*IAX(LASTI + 1.FDIK*CLASTID.DLASTBLK»FDIR A C0 3.DEOVBLK) ' 


1601 





47:3 


76 


IF RT11ISH THEM 


1602 


J 


4714 


79 


IF FbEGS DIM 2 <= SSE&S THEN 


1603 


u 


47:5 


86 


BEGIN FSEGS *.= SSEGSJ QHMX := SINX END 


1604 





47:4 


92 


ELSE FSEGS := (FSEGS+1) DIM 2 


1605 





47:2 


97 


END 


1606 


o 


47:1 


101 


ELSE 


1607 


a 


47:2 


103 


begin i := l; 


1608 


a 


47:3 


106 


WHILE 1 <= LASTI DO 


1609 





47:4 


111 


BEGIN 


1610 





47:5 


111 


IF FDlR'Cn.DFIRSTBLK-FDlR^CI-lJ.DLASTBLK >= FSEGS THEr* 


1611 





4756 


128 


BEGIN DINX := I; I := LASTI END; 


1612 





47:5 


134 


I := i+i 


1613 





47:4 


135 


END; 


1611 





47:3 


141 


IF DINX = THEN 


1615 





47:4 


146 


IF FDIR A C03.DEOVBLK-FDIR"CLASTID.DLASTBLK >= FSEGS THEN 


1616 





47:5 


161 


DINX := LASTI+1 


1617 
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162 


end; 


1618 





47:1 


166 


IF LASTI = MAXDIR THEN DINX ;= 0; 


1619 





47:1 


174 


IF DINX > THEN 


1620 





47:2 


179 


BEGIN 


1621 
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17^ 


WITH LDE DO 


1622 
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179 


BEGIN 


1623 





47:5 


179 


DFIRST3LK ;= FDIR A CDINX-1 D.DLASTBLK ; 
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188 


OLASTBLK := DFIRSTBLK+FSEGS 5 


1625 
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193 


OFKIND := FKIND; DTID :r FTID; 


1626 
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204 


DLASTBYTE := FBLKSIZE; 


1627 





47:5 


209 


WITH DACCESS DO 
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BEGIN MONTH := o; DAY := 0« YEAR := 100 END 
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end; 
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INSENTRY( LDE ♦ DINX, FDIR) 
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end; 
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entertemp := dinx 
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END (*ENTERTEMP*) ! 
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(* FILE STATE HANDLERS *) 
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procedure: finit<*var f: fib; window: windowp? recwords: integer*) 


1638 





3:o 





3EGIN 


1639 


3 


3:i 





WITH F DO 


1640 





3:2 


3 


3EGIM FSTATE := F^ANDw; 
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fisopen := false:; feof := true; 

feol.n := true; fwinoow := window? 

if (recwords = 0) or (recwords = -2) then 

3EGIN 

FwiNDOarciu := chr(o); frecsize := 1; 

IF RECWORDS = THEN FSTATE := FNEEDCHAR 
END 
ELSE 

IF RECWORDS < THEN 

BEGIN FWINOOW := NIL? FRECSIZE := END 
ELSE FRECSIZE := RECWORDS+RECWORDS 
END 
END (*FINIT*) J 

PROCEDURE RESETERCVAR F:FIB){ 

VAR BlSGER: BOOLEAN; 
BEGIN 

WITH F DO 

begin freptcnt := 0? 

feoln := false; feof := false; 

IF FISBLKD THEN 

BEGIN BIGGER := FNXTBLK > FMAXBLK; 
IF BIGGER THEN FMAXBLK := FNXTBLK; 
IF FSOFTBUF THEN 
BEGIN 

IF BIGGER THEN FMAXBYTE := FNXTBYTE 
ELSE 

IF FNXTBLK = FMAXBLK THEN 
IF FNXTBYTE > FMAXBYTE THEN 

BEGIN BIGGER := TRUE; FMAXBYTE := FNXTBYTE END; 
IF FBUFCHNGD THEN 

BEGIN FBUFCHNGD := FALSE; FMODIFIED := TRUE; 
IF BIGGER THEN 

FILLCHAR(FBUFFERCFNXTBYTED,FBLKSlZE-FNXTBYTE.O); 
UNITWRITE(FUNIT,F3UFFER»FBLKSIZE, 

FHEADER.DFIRSTBLK+FNXTBLK-1) I 
IF BIGGER AND (FHEADER.DFKIND = TEXTFILE) 
AND ODD(FNXTBLK) THEN 
BEGIN FMAXBLK := FMAXBLK+1; 

FILLCHAR(FBUFFER.FBLKSIZEiO); 41 

UNITWRITE(FUNIT,FBUFFERiFBLKSIZEi * X 
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FHEADER. OFIRSTBLK+FNXTBLK) 

END 

e r-j o ; 

FNXTBYTE := FBLKSIZE 

end; 

FNXT3LK := 0; 

IF FSOFTBUF AND ( FHEADER .QFKINQ = TEXTFILE) THEN 
FNXTBLK := 2 
END 
END 
END (*RESETER*) ; 

PROCEDURE FOPEN(*VAR F: FIB; VAR FTITLE: STRING! 

FOPENOLD: BOOLEAN! JUNK PARAM*); 
LABEL l; 

var ldir: dirp; lunit: unitnum; linx: DIRRANGE; 
lsegs,nbytes: integer; lkind: filekind; 
oldheap: ^integer; swapped: boolean; 
saverslt: iorsltwd; lvid: vids ltid: tid; 

BEGIN SYSCOM'MORSLT := INOERRORi 
WITH F DO 

IF FISOPEN THEN SYSCOM*. IQRSLT := INOTCLOSED 
ELSE 

if scantitle(ftitle,lvld»ltidtlsegs. lkind) then 
begin (*got an ok title*) 
if ord(fopenold) > 1 then <*old code special case*) 

fopenold := (ord(fopenold) = 2) or ( ord(fopenold) = 4); 
swapped := false; 
with swapfib" do 
if fisopen and ( syscovt.gdirp = nil) then 
begin mark(oldheap) ; 
nbytes := orotsyscom^.lastmpj-ordtoldheap) ; 
if (nbytes > 0) and (nbytes < sizeof(directory) +400) then 

BEGIN 

NBYTES := ORD(OLDHEAP)-ORD(EMPTYHEAP) ; 

IF (NBYTES > 0) AND (NBYTES > SI2EOF (DIRECTORY ) ) AND 

(UNITABLECFUNin.UVIO = FVID) THEN 
BEGIN 

UNITWRITE(FUNIT,EMPTYHEAP", SI ZEOF( DIRECTORY) , 

FHEADER. DFIRSTBLK) ; 
RELEAf EMPTYHEAP); SWAPPED := TRUE 
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END; 
LU!\JIT := VoLSEARCH(LVIDiTRUEiLDIR) ; 
IF LUNIT = THEN SYSCOM*.IORSLT := INOUNIT 
ELSE 

with uni taolec lunit 1 do 
begin (*ok.,.open up file*) 
fisopen := true; fmodified != false; 
funit := lunit; fvid := lvid; 
fnxtblk := 05 fisblkd 1= uisblkd; 
fsoftbuf := uisblkd and (frecsize <> 
if (ldir <> nil) and (length! ltid) > 
begin <*lookup or enter fheader in 



0); 

0) THEN 
DIRECTORY*) 



LINX := DIRSEARCH(LTID*F0PEN0LD»LDIR); 
IF FOPENOLD THEN 
IF LINX = THEN 

BEGIN SYSCOM^.IORSLT := INOFILE; GOTO 1 END 
ELSE FHEADER := LDIR*CLINX3 
ELSE (*OPEN NEW FILE*) 
IF LINX > THEN 

BEGIN SYSCOM A .IORSLT := IDUPFILEJ GOTO 1 END 
ELSE 

BEGIN (*MAKE A TEMP ENTRY*) 

IF LKIND = UNTYPEDFILE THEN LKIND := DATAFILE; 
LINX := ENTERTEMP(LTID,LSEGS»LKIND»LDIR); 
IF (LINX > 0) AND (LKIND = TEXTFILE) THEN 
WITH LDIR^CLINX] DO 
BEGIN 

IF ODD(DLASTBLK-DFIRSTBLK) THEN 

DLASTBLK := DLASTBLK-i; 
IF DLASTBLK-DFIRSTBLK < 4 THEN 

BEGIN DELENTRY(LINXtLDIR); LINX := END 
END? 
IF LINX = THEN 

BEGIN SYSCOMA.IORSLT 
FHEADER := LDIR^CLINXD; 
WRITEDIR(LUNIT,LDIR) 
END 
END 
ELSE (*FHEADER NOT IN DIRECTORY*) 



!= INOROOM; 
FMODIFIED 



GOTO 1 END; 

;= true; 
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1794 
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1795 





5 


5 


628 
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1797 
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1798 
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1799 
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!6 
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1800 
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651 


1801 
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658 


1802 





b: 
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666 


1803 





b: 
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684 


1804 





b: 
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684 



IF 



BEGIN 

IF FOPENOLD 
BEGIN 

SYSCOF1'" 
GOTO 15 
END; 
WITH FHEADE 
BEGIN (*D 
DFIRST3 
IF UIS3 
DFKIND 
DLASTBY 
WITH DA 
BEGIN 
END; COF 
END! COF E 
IF FOPENOLD THE 
FWIAXBLK := FH 
ELSE FMAXBLK := 
IF FSOFTBUF THE 
BEGIN 

FNXTBYTE := 

IF FOPENOLD 

ELSE FMAXBY 

WITH FHEADE 

IF DFKIND 

BEGIN F 

IF NO 

BEG 

F 

U 

U 

END 

END 

end; 

IF FOPENOLD THE 

ELSE RLSETER(F) 

IF SYSCONT.IORS 

BEGIN FISOPEN 

end; 
swapped then 



and ( length (ltid) <> 0) then 
.iorslt := inofile; 



!= 0! DLASTBLK 
THEN DLASTBLK 
.KIND; DTID : 
;= FBLKSI2E5 
SS DO 

JTH := o; DAY 
13 



i~ MMAXINT* 
:= UEOVBLK; 



= • » 



:= o; year := o end 



R DO 

IRECT UNIT OPENt SET UP DUMMY FHEADER*) 

LK 
LKD 

:= L( 

TE 
CCES! 

WON' 
WITH 
LSED 
N 
EADER.DLASTBLK-FHEADER.DFIRSTBLK 

0; 

M 

FBLKSIZE; FBUFCHNGD := FALSE; 

THEN FMAXBYTE := FHEADER. DLASTBYTE 
TE := FBLKSIZE; 
R DO 

= TEXTFILE THEN 
NXTBLK := 2! 
T FOPENOLD THEN 

IN (*NEW .TEXTi PUT NULLS IN FIRST PAGE*) 
ILLCHAR(FBUFFER»SIZE0F(FBUFFER) i0) ; 
NITWRITE(FUNIT»FBUFFER, FBLKSIZE i DFIRSTBLK) J 
NITWRITE(FUNIT,FBUFFER, FBLKSIZE ,DFIRSTBLK+1 ) 



N FRESET(F) 
; (*N0 GET!*) 
LT <> INOERROR THEN 
;= FALSE; FEOF := TRUE? 



FEOLN := TRUE END 



1805 ° &!6 °57 BEGIN RE L EASE ( OLDHE AP ) ; SYSCOM". GDIRP := NIL! 

iao& ° 5:7 693 SAVERSLT := SYSCOM" . IORSLT ; 

1807 5:7 704 UNITREAQ(SWAPFI3~.FUNIT,EMPTYHEAP'\SIZE0F{DIRECT0RY>» 

1308 5:7 715 SwAPFIB~ .FHEADER.DFIRSTBLK ) ; 

1309 5:7 723 SYSCOM*. IORSLT := SAVERSLT 

1810 5:6 726 END 

1811 5:4 728 end 

1812 5:3 728 ELSE SYSCOM*. IORSLT := IBADTITLE 

1813 5:0 733 END (*FO?EN*> ; 

1814 5:0 758 

1815 6:D 1 PROCEDURE FCLOSE(*VAR F: FIB; FTYPE: CLOSETYPE*); 

1816 6:D 3 LABEL 1; 

1817 <=:D 3 VAR LINX.DUPINX: DIRRANGE; LDIR: DIRP; FOUND: BOOLEAN; 

1818 6:0 BEGIN SYSCOM*. IORSLT := INOERROR; 

1819 6:i 5 WITH F DO 

1820 6:2 8 IF FISOPEN AND (FWINDOW <> SYSTER^T .FWINDOW) THEN 

1821 6:3 20 BEGIN 

1822 6:4 20 IF FISBLKD THEN 

1823 6!5 24 WITH FHEADER DO 

182* 6:6 29 IF LENGTH(DTID) > THEN 

1825 6:7 38 BEGIN (*FII_E IN A DISK DIRECTORY. . .FIXUP MAYBE*) 

1826 6:8 38 IF FTYPE = CCRUNCH THEN 

1827 619 43 BEGIN FMAXBLK := FNXTBLK5 

1828 ° 6; 50 DACCESS.YEAR := 100; FTYPE := CLOCK; 

1829 6:0 60 IF FSOFTBUF THEN FMAXBYTE := FNXTBYTE 

1830 6:9 68 END? 

1831 6:8 72 RESETER(F); 

1832 6:8 75 IF FMODIFIED OR (DACCESS.YEAR = 100) OR (FTYPE = CPURGE) THEN 

1833 6:9 93 BEGIN (*HAVE TO CHANGE DIRECTORY ENTRY*) 

1834 6:0 93 IF FUNIT <> VOLSEARCH(FVID.FALSE»LOIR) THEN 

1835 611 108 BEGIN SYSCOM A . IORSLT : = ILOSTUNIT; GOTO 1 END? 
i 836 & :o 115 L INX := 1; FOUND := FALSE; 

1837 6:0 121 WHILE (LINX <= LDIR*C 3.DNUMFILES) AND NOT FOUND DO 

1838 &:i 134 BEGIN ULOOK FOR FIRST BLOCK MATCH*) 

1839 6:2 134 FOUND := (LDIR^CLINXJ.DFIRSTBLK = DFIRSTBLK) AND 

1840 6:2 142 <LDIR~CLINX3.DLASTBLK = DLASTBLK); 

1841 &:2 153 LINX := LINX + 1 

1842 6:1 154 ENO; 

1843 6:0 160 IF NOT FOUND THEN 

1844 6:1 164 BEGIN SYSCOM*. IORSLT := ILOSTFILE; GOTO 1 END; *<c- 

1845 6:0 171 LINX := LINX - 1! (*CORRECT OVERRUN*) ^ D 
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IF ((FTYPE = CWOKMAL) AND <LDlR~CLlNX3. DACCESS. YEAR = 100)) 
OR (FTYPE = CPURGE) THEN 
DELENTRY(LINX»LDIR> (*ZAP FILE OUT OF EXISTANCE*) 
ELSE 

BEGIN UiaIELL...LOCK IN A PERM DIR ENTRY*) 
UUPINX := DIRSEARCH(DTID,TRUE,LDIR) ! 
IF (uUPINX <> 0) AND (DUPINX <> LINX) THEN 

BEGIN <*A DUPLICATE PERM ENTRY. ..ZAP OLD ONE*) 
DELENTRY<DUPINX,LDIR) 5 
IF DUPINX < LINX THEN LINX := LINX-1 
END; 
IF LDIR^CLINXH. DACCESS. YEAR = 100 THEN 
IF DACCESS.YEAR = 100 THEN 

DACCESS := THEDATE 
ELSE ULEAVE ALONE. . .FILER SPECIAL CASE*) 
ELSE 

IF FMODIFIED AND { THEDATE. MONTH <> 0) THEN 

DACCESS := THEDATE 
ELSE 

DACCESS := LDIR~CLINX3. DACCESS? 
DLASTBLK != DFIRSTBLK+FMAXBLK 5 
IF FSOFTBUF THEN DLASTBYTE := FMAXBYTE; 
FHEADER.FILLER1 := 0? CTHIS HAD BETTER WORK, STEVE3 
FMODIFIED := FALSE! LDIR^CLINXD := FHEADER 
END; 
WRlTEDlR(FUNITfLDIR) 
END 

end; 
if ftype = cpurge then 
if length(fheader.dtid) = then 

UNITABLECFUNITU.UVID := ••; 
FEOF := TRUE; FEOLN := TRUE; FISOPEN := FALSE 

END; 

(*fclose*) ; 
system. b d 

SYSTEM. C 3 

(* *) 

(* COPYRIGHT (C) 1978 REGENTS OF THE UNIVERSITY OF CALIFORNIA. *) 
(* PERMISSION TO COPY OR "STRIBUTE THIS SOFTWARE OR DOCUMEN- *^ 



1887 o VA III !* Tfl I IOr < IW HARD OR SOFT COPY GRANTED ONLY BY WRITTEN LICENSE *> 

1883 o 6.0 HI \l 3BTAINED "<*« ™ E INSTITUTE FOR INFORMATION SYSTEMS. V) 

1890 sin HI ( *********************************************^ 

{HI I *l° ^ 22 <* INPUT-OUTPUT PRIMITIVES *) 

"?i o Hi ? e s xe s c c e r; r xeqerr := ll; c NoT imp err D 

J5!I ° 9:0 7 END (*XSEEK*) ; 

1896 9:0 22 

llll 2 J!!:S * PR0CE DURE XREADREAL; 

i9oo o m:o o begin 

"SJ S iJ-J ? r^°r- XEaERR := 11? C N0T «P ERR ^ 

,, J t,* 1 7 execerror 

tint ! ^ : ° 7 END <*XREAOREAL*) ; 

1904 l<+;o 22 

"o" S lt\l ° 7 »Jgg||^"ERRI. 11, c N0THP«R-3 

ino S "IS 22 7 END <**»"^REAL.> , 

»M S 50°;S 2 FUNCTION^MNTSTRETCH.VAR f, F IB)! BOOLEAN! (.REPLACED Br RJH SMAR78.) 

E !■ |j° l "« 5 CA^r^^'TRSETo^i^A^r LAV4IL8LK! INT " ER1 ""' ™"> 

JIJ5 X .J 11 & WITH F'FHEADER DO 

1918 tV-l IS IF L ENGTH(DTID) > THEN 

1919 q sS-'u o* BEGIN ( * IN A DIRECTORY FOR SURE*) 

1920 50 : 5 11 IF ar U r N r 1T ° VOLSE ARCH < F V I D , FALSE , LD I R ) THEN 

»g ;< « Fo^ Gi ^%^;^^ sL i = : i 5 iLosTuNiT{ goto i end ' 

1923 50-5 II "' H BEGIN LINX <= LDIR ~ C ° D ' DNUMF I LE S > AND NOT FOUND DO 

19§5 I lilt 72 F ° UND := iJ-DJ^CLlNXD.DFIRSTBLK = DFIRSTBLK, AND 

1926 50.6 It LJNX :=l ^I^LINX,.DLASTBLK = DLASTBLK», ^ 
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21 

28 

35 

37 

50 

3 
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END; 

IF NOT FOUf. 1 

3ESIN SYS 

IF LI MX > L 

LAVAILBLK 

ELSE LAVAIL 

IF (DLASTBL 

BEGIN 

WITH LD 

BEGIN 

OLA 

WRI 

IF 

end; 
feof := 

IF FSTA 
DLASTBL 
DACCESS 
END5 

ok := true; 

end; 

i: IF NOT OK THEN 
BEGIN F.FEOF 
END UCANTSTRETCH*) 



D THEN 

COW.IORSLT := ILOSTFILE; GOTO 1 END; 

DIR^COJ.DNUMFIlES THEN 

:= ldir^coh.deovblk 
3lk := ldir*clinx:.dfirstblk; 
k < lavailblk) or (dlastbyte < fblksize) then 

iftclinx-13 do 

stblk := lavailblk; dlastbyte := fblksize; 

TEDIR(FUNITiLQIR) ; 

IORESULT <> ORD(INOERROR) THEN GOTO 1 

FALSE; FEOLN := FALSE; 
TE <> FJANDW THEN FSTATE := FNEEDCHAR; (*RJH 2MAR78*) 
K := LAVAILBLK; DLASTBYTE := FBLKSIZE; 
.YEAR ;= 100; CANTSTRETCH := FALSE 



:= true; f.feoln := true end 



PROCEDURE FRESET(*VAR f: fib*); 
BEGIN SYSCOM^.IORSLT := INOERROR; 
WITH F DO 

IF FisOPEN THEN 

BEGIN RESETER(F) ! 

IF FRECSIZE > THEN 

IF FSTATE = FJANDW THEN FGET(F) 
ELSE FSTATE := FNEEDCHAR 
END 
END <*FRESET*> 5 

FUNCTION F3L0CKI0(*VAR F: FIB; VAR A: WINDOW; I: INTEGER; 

NBLOCKStRBLOCK: INTEGER; DOREAD: BOOLEAN*); 

3EGIN fblockio := 0; syscom^.iorslt := inoerror; 

WITH F 00 

IF FISOPEN AND (NBLOCKS >f ) THEN 
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IF FIS3LK0 THEN 
rflTH FHEADER DO 
BEGIN 

IF RBLOCK < THEN R3L0CK := FNXTBLK; 

R8L0CK := ofirstblk+rblock; 

IF RBLOCK+NBLOCKS > DLAST3LK THEN 
IF NOT DOREAD THEM 

IF CANTSTRETCH( F ) THEN; 
IF RBLOCK+NBLOCKS > 0LAST3LK THEN 

NBLOCKS := DLASTBLK-RBLOCK; 
FEOF := RBLOCK >= DLASTBLKJ 
IF NOT FEOF THEN 
BEGIN 

IF DOREAD THEN 

UNITREAD(FUNIT,ACI3.NBL0CKS*FBLKSIZE»RBL0CK) 
ELSE 

BEGIN FMODIFIED := TRUE? 

UNlTWRlTE(FUNIT,ACn,NBLOCKS*FBLKSlZEiRBLOCK) 
END! 
FBLOCKIO := NBLOCKS; 
RBLOCK := RBLOCK+NBLOCKS; 
FEOF := RBLOCK = DLASTBLKJ 
FNXTBLK := RBLOCK-DFIRSTBLKl 

IF FNXTBLK > FMAXBLK THEN FMAXBLK J= FNXTBLK 
END 
END 
ELSE 

BEGIN FBLOCKIO := NBLOCKS; 
IF DOREAD THEN 

UNITREAD(FUNITiACl3,NBLOCKS«FBLKSIZE,RBLOCK) 
ELSE 

UNITWRITE(FUNIT,ACI3,NBL0CKS*FBLKSIZE»RBL0CK)I 
IF IORESULT = ORD(INOERROR) THEN 
IF DOREAD THEN 

BEGIN RBLOCK := N3L0CKS*FBLKSIZE ; 

RBLOCK := RBLOCK+SCAN(-RBLOCK«OCHR(0)tACI+RBLOCK-13) J 
RBLOCK := (RBLOCK+FBLKSIZE-1) DIV FBLKSIZE; 
FBLOCKIO := RBLOCK; 
FEOF := RBLOCK < NBLOCKS 
END 
ELSE 
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ELSE FBLOCKIU := 

END 
ELSE 

SYSCOM-.IORSLT '~ INOTOPEM 
END UFBLOCKIO*) ' 

PROCEDURE FGET(*VAR pi FIB*) 5 
LA3EL 1, 2; 
VAR LEFTOGET.WININX1LEFTINBUF1AMOUNT: INTEGER. 

DONE: BOOLEAN; 
BEGIN SYSCOM^.IORSLT *.= INOERROR; 
WITH F DO 

IF FISOPEN THEN 
BEGIN 

IF FREPTCNT > Q THEN 

BEGIN FREPTCNT := FREPTCNT-1? IF FREPTCNT > THEN GOTO 2 END J 
IF FSOFTBUF THEN 
WITH FHEADER DO 
BEGIN 

leftoget := frecsize; wininx := o» 

REPEAT 

IF FNXTBLK = FMAXBLK THEN 

IF FNXTBYTE+LEFTOGET > FMAXBYTE THEN GOTO 1 

ELSE LEFTINBUF := DLASTBYTE-FNXTBYTE 
ELSE LEFTINBUF := FBLKSIZE-FNXTBYTE ; 
AMOUNT := LEFTOGET; 

IF AMOUNT > LEFTINBUF THEN AMOUNT := LEFTINBUF? 
IF AMOUNT > THEN 

BEGIN 

MQVELEFT(FBUFFERCFNXTBYTE 3 ♦FWlNDOW^CWININXDt AMOUNT) J 

fnxtbyte := fnxtbyte+amount ; 
wininx := wininx+amount; 
leftoget := leftoget-amount 

end; 
done := leftoget = 0; 

if not done then 

BEGIN 

IF FBUFCHNGD THEN 

BEGIN FBUFCHNGD := FALSE? FMODIFIED := TRUE; 

UNlTWRlTE(FUNlT«FBUFFER»FBLKSlZEtDFIRSTBLK+FNXTBLK-l) 

END; 
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ELSE 



IF IORESULT <> ORD(INOERROR) THEN GOTO 15 
UMlTREADCFUMlT.FBUFFERtFBLKSlZEtDFlRSTBLK+FNXTBLK) 
IF IORESULT <> ORD(IMOERROR) THEN GOTO 1! 
FNXTBLK := FNXTBLK+1; FNXTBYTE := 
EMQ 
UNTIL GONE 
END 
ELSE 
6EGIN 

UNI TREAD (FUNITtFWINDOInTtFRECSlZE) ! 
IF IORESULT <> ORD(INOERROR) THEN GOTO 1 
END; 

FRECSIZE = 1 THEN (*FILE OF CHAR*) 
BEGIN FEOLN := FALSE? 

IF FSTATE <> FJANDW THEN FSTATE := FGOTCHAR; 
IF FWINOoW'COa = CHR(EOL) THEN 

BEGIN FWINDOWC03 != » • * FEOLN := TRUE; GOTO 2 END; 
IF FWINOOWC03 = CHR(DLE) THEN 
BEGIN FGET(F) ; 

AMOUNT := ORD(FWINDOW*C03)-32i 
IF (AMOUNT > 0) AND (AMOUNT <= 127) THEN 
BEGIN 

FWINDOWCOD := • •; 
freptcnt := AMOUNT! 
GOTO 2 

end; 

FGET(F) 

end; 
if fwindowcod = chr(0) then 
begin (*lof handling*) 

IF FSOFTBUF AND ( FHEADER.DFKIND = TEXTFILE) THEN 
BEGIN (*END OF 2 BLOCK PAGE*) 

IF ODD(FNXT3LK) THEN FNXTBLK := FNXTBLK+1; 
FNXTBYTE := FBLKSIZE; FGET(F) 
END 
ELSE 



BEGIN FWINDOW^COD := • •; GOTO 1 END 



END 



END 
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2091 3 7:3 4J3 r3 E ^ I TJ 

2092 G 7:4- 4C3 SYSC3;"~ . IORSlT := INOTOPEN; 

2093 o 7:t fua i: feof := true; feoln := true 

^094 7:3 Hfa END; 

2095 7U 418 2: 

2096 7:0 413 END UFGET*) ; 

2097 7:0 442 

2093 8:0 1 PROCEDURE FPUT(*VAR f: FIB*)! 

2099 8:D 2 LABEL 1; 

2100 8:D 2 VAR LEFTOPUT , WININX i LEFTINBUF » AMOUNT : INTEGER; 

2101 8:j 6 DONE! 300l.EAN; 

2102 o 8:o o begin SYSCOM~.IORSLT := inoerror; 

2103 8:1 5 WITH F DO 

2104 6:2 8 IF FlsOPEN THEN 

2105 8:3 12 3EGIN 

2106 8:4 12 IF FSOFTBUF THEN 

2107 8:5 17 WITH FHEADER DO 

2108 8:& 22 BEGIN 

2109 8:7 22 LEFTOPllT := FRECSIZE; WININX := 05 

2110 8:7 29 REPEAT 

2111 8:8 29 IF DFIRSTBLK+FNXTBLK = DLASTBLK THEN 

2112 8:9 40 IF FNXTBYTE+LEFTOPUT > DLASTBYTE THEN 

2113 8:0 51 IF CANTSTRETCHt F ) THEN 

2114 8:i 58 BEGIN SYSCONT. IORSLT := INOROOM; GOTO 1 END 

2115 8:0 65 ELSE LEFTINBUF := FBLKSIZE-FNXTBYTE 

2116 8:9 70 ELSE LEFTINBUF := DLAST3YTE-FNXTBYTE 

2117 8:8 81 ELSE LEFTINBUF := FBLKSIZE-FNXTBYTE! 

2118 8:8 98 AMOUNT := LEFTOPUT; 

2119 8:8 101 IF AMOUNT > LEFTINBUF THEN AMOUNT := LEFTINBUF; 

2120 8:8 109 IF AMOUNT > THEN 

2121 8:9 114 BEGIN FBUFCHNGD := TRUE; 

2122 8:0 119 MOVELEFT(FWINDOW v i:WlNINX3tFBUFFERCFNXTBYTE:»AMOUNT) ; 

2123 8!0 131 FNXTBYTE := FNXTSYTE+AMOUNT 5 

2124 8:0 140 WININX := WININX+AMOUNT 5 

2125 8:0 145 LEFTOPUT := LEFTOPUT-AMOUNT 

2126 8!9 146 END; 

2127 8:6 150 DONE := LEFTOPUT = 0! 

2128 3 8:8 155 IF NOT DONE THEN 

2129 8:9 159 BEGIN 

2130 8:0 159 IF FBUFCHNGD THEN 

2131 8U 164 BEGIN FF 'CHNGD := FALSE; FMODIFIED := TRUE; 
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UImITWRITE(FUNIT,FSUFFERiFBLKSIZE,DFIRSTBLK + FNXTBLK-1) 
END; 

IF IORESULT <> ORD(INOERROR) THEN GOTO 1; 
IF FNXTBLK < FMAX3LK THEN 

UNlTREAQ<FUNIT,FBUFFER,FBLKSIZEtDFIRSTBLK+FNXTBLK) 
ELSE 

FILLCHAR(F3UFFER.FBLKSIZEiCHR(0) ) ; 
IF IORESULT <> ORDdNOERROR) THEN GOTO l; 
FNXTBLK := FNXT3LK+1; FNXTBYTE := 
END 
UNTIL DONE; 
IF FRECSIZE = 1 THEN 

IF FWlNDOhTCOD = CHR(EOL) THEN 
IF DFKIND = TEXTFILE THEN 

IF (FNXTBYTE >= F3LKSIZE-127) AND NOT ODD<FNXTBLK) THEN 
BEGIN 

FNXTBYTE := FBLKSIZE-li 
FWlNDOhTCO] := CHR(O); 
FPUT(F) 
END 
END 
ELSE 
8EGIN 

UNITWRITE(FUNIT,FWlNQOWN FRECSIZE) ? 
IF IORESULT <> ORD(INOERROR) THEN GOTO 1 
END 
END 
ELSE 
BEGIN 

SYSCONT.IORSLT := INOTOPEN5 
i: FEOF := TRUE; FEOLN := TRUE 

END 
END (*FPUT*> ? 

FUNCTION FEOF(*VAR F; FIB*); 
BEGIN FEOF 1= F.FEOF END; 

(* TEXT FILE INTRINSICS *) 

FUNCTION FEOLN(*VAR f: FIB*); -_■ } 

BEGIN FEOLN := F. FEOLN END; 53 
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16 

1 PROCEDURE: Frt*ITELN<*\/AR F: FIE*); 

3EGIN 

F.FwiNjQW^COD := CHR(EOL); FPUT(F) 

6 END UFWRITElN*) ; 
20 

1 PROCEDURE FWRITECHAR(*VAR F: FI3; CH: CHAR! RLENG: INTEGER*)! 

4 LABEL i; 
3EGIM 

WITH F DO 

3 IF FISOPEN THEN 

7 IF FSOFTBUF THEN 
12 BEGIN 

12 WHILE RLENG > 1 DO 

17 BEGIN FWINDOW^C03 := ' 'J FPUT(F); 

25 RLENG := RLENG-1 

26 END? 

32 FWINDOkTCOD .!= CH; FPUT(F) 

38 END 

40 ELSE 

42 BEGIN 

42 *IHILE RLENG > 1 DO 

47 BEGIN FWlNDOW^COa := » M 

52 UNITWRITE(FUNIT,FWIND0W*»1){ 

62 RLENG := RLENG-1 

63 end; 

69 fwindowcq3 := ch; 

74 UNITWRlTE(FUNIT,FWlNDOW»tl) 

84 END 

84 ELSE SYSCOM^.IORSLT != INOTOPEN; 

91 i: 

91 END (*FWRITECHAR*) J 
108 

1 PROCEDURE FWRITEINT(*VAR F: FIB; I, RLENG: INTEGER*); 

4 LABEL l; 

4 var pot, col! integer' ch: char; 

7 suppressing: boolean; s: stringciod; 

begin col := 1; 

3 sco] := chr(IO); suppressing := true; 

11 IF I < THEN 

16 3egIm 1 := ABS(i); scid :j -»; col := 2; 
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if i = then (*harqwake special case*) 
3egin s := •-32768 1 ; goto 1 emd 

end; 

FOR pOT := 4 DOWNTO DO 

BEGIN CH := CHR(I DIV IPOTC D OT3 + ORD(»0»)); 

IF (CH = 'OM AND (POT > 0) AND SUPPRESSING THEN 
ELSE UFORMAT THE CHAR*) 

3EGIN SUPPRESSING .*= FALSE; 

sccolj := en; col := col+is 

IF CH <> »o» THEN I := I MOD IPOTCPOTD 

END 

end; 

SCO} := CHR(COL-l) ; 
lJIF RLENG < LENGTH(S) THEN 
RLENG .*= LENGTH(S) 5 

FWRITESTRING(F,S» RLENG) 
END (*FWRITEINT*) ; 

PROCEDURE FWRITESTRING(*VAR F; FIB; VAR S: STRING? RLENG: INTEGER*); 

BEGIN 

WITH F DO 

IF FISOPEN THEN 
BEGIN 

IF RLENG <= THEN RLENG := LENGTH(S); 
IF RLENG > LENGTH(S) THEN 

BEGIN FWRITECHAR1F.' • , RLENG-LENGTH( S) ) { RLENG != LENGTH(S) END! 
IF FSOFTBUF THEN ' 

BEGIN SINX := is 

WHILE (SINX <= RLENG) AND NOT FEOF DO 

BEGIN FWINDOW*C03 !r SCSINX35 FPUT(F); SINX := SINX+1 END 
END 
ELSE 

UNITWRITE(FUNIT,SC ID. RLENG) 

END 

ELSE SYSCOM^.IORSLT := INOTOPEN 
END (*FWRITESTRING*) ; 

PROCEDURE FREADSTRING(*VAR F: FIB; VAR S; STRING; SLENG: INTEGER*); 

VAR SI^X: INTEGER; CH: CHAR; 
BEGIN 55 



DO 



2255 16 :i Q WITH F 00 

2256 18.-2 3 BE3IN SINX := 1! 

2257 1613 . 6 IF FSTATE = FNEEDCHAR THEN FGET(F)5 
2253 18:3 lb SCO] := CHR(SLENG)! UNO INv/ INDEX*) 

2259 16:3 19 WHILE (SINX <= SLENG) AND NOT (FEOLN OR FEOF) DO 

2260 18:4 31 BEGIN CH ; = FWIPJDOW A CO D; 

2261 18:5 37 IF FUNIT = 1 THEN 

2262 18:6 43 IF CHECKDEL ( CH t SINX ) THEN 

2263 1856 52 ELSE 

2264 18:7 o4 BEGIN SCSINXD := CH; SINX .*= SINX + 1 END 

2265 1855 63 ELSE 

2266 18:6 65 BEGIN SCSINX3 := CH; SINX • = SINX + 1 END; 

2267 18:5 74 FGET(F) 
2266 18:4 75 END; 

2269 18:3 79 S COJ := CHR(SlNX - 1); 

2270 1813 85 WHILE NOT FEOLN DO FGET(F) 

2271 18:2 91 END 

2272 18:0 95 END ( *FREADSTRING*) ; 

2273 18:0 112 

2274 20:D 1 PROCEDURE FWRITEBYTES< *VAR F: FIB; VAR A: WINDOW; RLENG, ALENG: INTEGER*) ! 

2275 20:D 5 VAR AlNX: INTEGER; 

2276 20!0 BEGIN 

2277 20:i WITH F pO 

2278 20:2 3 IF FISOPEN THEN 

2279 20:3 7 BEGIN 

2280 20:4 7 IF RLENG > ALENG THEN 

2281 20:5 12 BEGIN FWRITECHAR (F» • • ♦ RLENG-ALENG) ; RLENG := ALENG END; 

2282 20:4 22 IF FSOFTBUF THEN 
2263 20:5 27 BEGIN AINx := 0; 

2284 20:6 30 WHILE (AINX < RLENG) AND NOT FEOF DO 

2285 20:7 39 BEGIN FWINDOW^C 3 := ACAINXD; FPUT(F); AINX := AINX+1 END 

2286 20:5 54 END 

2287 20:4 56 ELSE 

2288 20:5 58 UNITWRITE(FUNIT,A,RLENG) 

2289 20:3 67 END 

2290 20:2 67 ELSE SYSCOM*. IORsLT := INOTOPEN 

2291 20:0 72 END ( *FWRI TE5YTES* ) ; 

2292 20:0 88 

2293 21ZD 1 PROCEDURE FREADLN(*VAR F: FIB*); 

2294 21:0 BEGIN 

2295 ?l:i WHILE NOT F. FEOLN QO FGET(F/ 



£296 D 2i;i 10 IF F.FSTATL = rjAND* THEN FGET(F) 

2297 2l:i 17 ELSE 

2298 U 21:2 21 BEGIN F.FSTATE := FNEEDCHAR; F.FEOLN := FALSE END 

2299 21:0 31 END <*FREADLN*) ; 

2300 21:0 46 

2301 1610 1 PROCEDURE FREADCHAR < *VAR Ft FlB; VAR CH: CHAR*); 

2302 16:0 3EGIN 

2303 1611 WITH F DO 

2304 16:2 3 BEGIN SYSCOM*. IORSLT := INOERROR; 

2305 16:3 8 IF FSTATE = FNEEDCHAR THEN FGET(F); 

2306 16:3 17 CH := FWINDOW A C D; 

2307 16:3 23 IF FSTATE = FJANDW THEN FGET(F) 

2308 16:3 30 ELSE FSTATE := FNEEDCHAR 

2309 16:2 37 END 

2310 16:0 39 END ( *FREADCHAR* ) 5 

2311 16:0 52 

2312 12:D 1 PROCEDURE FREADINT ( *VAR F: FlBt VAR I: INTEGER*) J 

2313 12*.D 3 LABEL 1; 

2314 12:D 3 VAR CH; CHAR; NEG.IVALID: BOOLEAN; SINx: INTEGER; 

2315 12:0 BEGIN 

2316 12:1 WITH F DO 

2317 12:2 3 BEGIN I := 0; NEG := FALSE; IVALID := FALSE; 

2318 12:3 12 IF FSTATE = FNEEDCHAR THEN FGETtFM 

2319 12:3 21 WHILE (FWINDOW~C 3 = • •) AND NOT FEOF DO FGET(F); 

2320 12-.3 38 IF FEOF THEN GOTO ll 

2321 12:3 44 CH := FWINDOW^COJ; 

2322 12:3 50 IF (CH = »+») OR (CH = •-•) THEN 

2323 12:4 59 BEGIN NEG := CH = »-»{ FGET(F); CH := FWINDOW^COD ENDJ 

2324 12:3 73 IF CH IN DIGITS THEN 

2325 12:4 83 BEGIN IVALID J= TRUE; SINX := 11 

2326 12:5 89 REPEAT 

2327 12:6 89 I := I*10 + ORD(CH)-ORD(»0M; 

2328 12:6 99 FGET(F); CH := FWINDOW~C0 3; SINX := SINX+l; 

2329 12:6 113 IF FUNIT = 1 THEN 

2330 12:7 119 WHILE CHECKDEL ( CH, SINX ) DO 

2331 12:8 128 BEGIN 

2332 12:9 128 IF SINX = 1 THEN I := ELSE I := I DIV 10; 

2333 12:9 144 FGET(F); CH := FWINDOW^C 03 

2334 12:8 150 END 

2335 12:5 153 UNTIL NOT (CH IN DIGITS) OR FEOLN r-> 

2336 12:4 164 END; J/ 



23.37 12:3 169 IF IVALIQ OR FEOF THEN 

^33 12:4. 175 IF NEG THEM I := -I ELSE (*NADA*) 

23:59 D x ^ :5 16^) £LSE SYSCOM-.IUKSLT := IQAOFORMAT 

2340 12:2 190 END; 

2341 12:1 192 i: 

2342 12:0 192 END UfREADINT*) 5 

2343 12:0 212 

2344 12:0 212 {* STRIN3 VARIABLE INTKINSICS *) 

2345 12:0 212 

2346 23:D 1 PROCEDURE SCONCAT < *VAR SRC. DEST: STRING; DESTLENg: INTEGER*); 
23^7 23:0 BEGIN 

2348 23!1 IF LENGTH ( SRC ) +LENGTH (DEST) <= DESTLENG THEN 

2349 23:2 11 BEGIN 

2350 23:3 11 MOVELEFT ( SRCCl ] t DESTCLENGTH (DEST ) +1 DtLENGTHt SRC )) ; 

2351 23:3 24 DESTC03 := CHR ( LENGTH( SRC ) +LENGTH( DEST ) ) 

2352 23:2 33 END 

2353 23:0 34 END (*SCONCAT*> ; 

2354 23:0 46 

2355 24:D 1 PROCEDURE SINSERT(*VAR SRCtDEST: STRING; DESTLENGi INSINX: INTEGER*)? 

2356 24:D 5 VAR ONRlGHT: INTEGERS 

2357 24:o BEGIN 

2358 24:1 IF (INsiNX > 0) AND (LENGTH(SRC) > 0) AND 

2359 24:i 9 (LENGTH(SRC)+LENGTH(DEST) <= QESTLENG) THEN 

2360 24:2 21 BEGIN 

2361 24:3 21 ONRlGHT : = LENGTH(DEST) -INSINX+1 ; 

2362 24:3 30 IF ONRlGHT > THEN 

2363 24!4 35 BEGIN 

2364 24:5 35 MOVERIGHT ( qESTC INSlNXIhDESTC INSINX+LENGTH(SRC ) D, ONRlGHT) J 

2365 24:5 46 ONRlGHT := 

2366 24:4 46 END; 

2367 24:3 49 IF ONRlGHT = THEN 

2368 24:4 54 BEGIN 

2369 24:5 54 MOVELEFT< SRCCl 3, DESK INSINX3. LENGTH* SRC ) ) J 

2370 24:5 63 DESTC03 := CHR (LENGTH(DEST) +LENGTH( SRC ) ) 

2371 24:4 72 r H Q 

2372 24:2 73 END 

2373 24:o 73 END (*SlNSERT*) ; 

2374 24:0 86 

2375 25:D 1 PROCEDURE SCOPY(*VAR SRC, DEST; STRING; SRCINX , COPYLENG: INTEGER*); 

2376 25:0 BEGIN DEST := "\ 

2377 ?5:i 6 IF (SRCINX > 0) AND (COPYLEf > 0) AND 



£376 25:i 13 ( SrtC INX+COPYLENG-1 <= LENSTH(SRO) THEN 

2573 Q 2b:2 25 BEGlM 

2380 Q 25:3 25 MOVELEFT ( SRCC SRC INX 1 . DESTC 1 1 , COPYLENG ) ; 

2381 25:3 32 DESTCOU := CHR ( COPYLENG ) 
2332 25:2 35 END 

2383 25:0 36 END <*SCopY*) ; 

2384 25:0 48 

2385 26:0 1 PROCEDURE SDELETE < *VaR DEST; STRING; DELINX ,DELLENG : INTEGER*); 
2336 26:0 4 VAR ONRlGHT: INTEGER' 

2387 26:0 BEGIN 

2388 26:i IF (DELINX > 0) AND (DELLENG > 0) THEN 

2389 26!2 9 BEGIN 

2390 26:3 9 ONRlGHT := LENGTH(DEST ) -DELINX-DELLENG+1 ; 

2391 26:3 20 IF ONRlGHT = THEN DESTC0D := CHR(DELINX-1 ) 

2392 26:3 30 ELSE 

2393 26:4 33 IF ONRlGHT > THEN 

2394 26:5 38 BEGIN 

2395 26:6 38 M0VELEFT( DESTCDELINX + DELLENGIJ.DESTCDELINXD.ONRIGHT) J 

2396 26:6 47 DESTC03 := CHR( LENGTH! DEST) -DELLENG) 

2397 26:5 54 END 

2398 26:2 55 END 

2399 26:0 55 END USDELETE*) 5 

2400 26:0 68 

2401 27:D 3 FUNCTION SPOS(*VAR TARGET, SRC: STRING*)} 

2402 27:D 5 LABEL i; 

2403 27:D 5 VAR TEMPLOC ,DIST: INTEGER? 

2404 27:D 7 FIRSTCH; CHAR; 

2405 27:D 8 TEMP: STRING; 

2406 o 27:0 o begin spos : = o; 

2407 27:i 3 IF LENGTH( TARGET) > THEN 

2408 27:2 10 BEGIN 

2409 27:3 10 FlRSTCH := TARGETC1D? 

2410 27:3 15 TEMPLOC := 11 

2411 27:3 16 DlST := LENGTH( SRC ) -LENGTH! TARGET) + l; 

2412 27:3 29 TE*PC03 := TARGETCQDi 

2413 27:3 36 WHILE TEMPLOC <= DIST DO 

2414 27:4 41 BEGIN 

2415 27:5 41 TEMPLOC := TEMPLOC + SCAN ( DIST-TEMPLOC ,=FIRSTCH»SRCCTEMPLOC 2) i 

2416 27:5 55 IF TEMPLOC>DIST THEN 

2417 27:6 60 GOTO 1; r ^ 

2418 27:5 62 MOVELEFT ( SRCC TEMPLOC 1 t TEMPC 1 D. LENGTH! TARGET) ) ; °^ 
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if t£mp=target then 

segin sp3s := temploc ; goto 1 end; 
temploc := temploc+1 

end 

END! 

i: 

END (*SP3S*) J 

(* main driver of system *) 

procedure command! 
var t: integer; 

BEGIN STATE != HALTlNlT; 
REPEAT 

RELEASE(EMPTYHEAP) 5 

WHILE UNITABLECSYSC0M A .SYSUNIT3.UVID <> SYVID DO 

BEGIN 

pl := 'put in :•; 

INSERT(SYVIDiPLi8) ; 

prompt; T := 4000; 

REPEAT T := T-l 
UNTIL T = 0? 

IF FETCHDIR(SYSCOM*.SYSUNIT) THEN 
END; 
STATE := GETCMD(STATE) J 
CASE STATE OF 

UPROGNOU,UPROGUOK.SYSPROGi 

componly»compandgo,compdebug» 
linkandgo»linkdebug: 

userpr0gram(nil,nil) j 
debugcall: 
debugger 
end; 

if state in ccomponly,compamdgo,compdebugd then 
if userinfo.errnum = then 
begin cthis is continued in finishcomp3 
fclose (user info. codefibp*, clock) 5 
if ord(ioresult) <> ord ( inoerror ) then 

BEGIN 

T := IGRESULT; 

WRITELN (OUTPUT) f 



2460 


u 


43:7 


173 


2461 




43:7 


175 


2462 


D 


43:6 


180 


2463 





43:4 


loO 


2461 





43:2 


180 


2465 





43:3 


138 


2466 





43:4 


138 


2467 





43:4 


198 


2468 





43:3 


206 


2469 





43:2 


208 


2470 





43:3 


217 


2471 





43:1 


213 


2472 





43:0 


223 


2473 





4310 


246 


2474 





i:o 





2475 





1:1 





2476 





1:1 


3 


2477 





1:1 


6 


2478 





1:2 


6 


2479 





1:2 


8 


2480 





1:3 


14 


2481 





1:1 


14 


2482 





1:0 


19 



CLEARLIfJfc-; 

printerror(iocioerror:,t) ; 
end; 
END; 
IF STATE IN CUPROGNOUiUPROG'JQKD THEN 
BEGIN 

FCLOSE(GFILESC03^ f CNORMAL) 5 
FCLOSE(GFILESC 13*, CLOCK) 
END; 
IF UMITBUSY(I) OR UNITBUSY(2) THEN 
UNITCLEAR(I) 
UNTIL STATE = HALTINIT 
END (*COMMAND*) ; 

BEGIN (*UCSD PASCAL SYSTEM*) 
EMPTYHEAP .*= NIL? 
INITIALIZE; 
REPEAT 
COMMAND; 

IF EMPTYHEAP <> NIL THEN 
INITIALIZE 
UNTIL EMPTYHEAP = NIL 
END UPASCALSYSTEM*) . 
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1 (*JL PKl'-jTtR:*) 
1 C$1 GLOBALS.TEXT] 
1 (*$U-*) 
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CIS+3 
J******************************************************************) 

i* *) 

(* COPYRIGHT (C) 1978 REGENTS OF THE UNIVERSITY OF CALIFORNIA. *) 

(* PERMISSION TO COPY OR DISTRIBUTE THIS SOFTWARE OR DOCUMEN- *) 

(* TATION IN HARD OR SOFT COPY GRANTED ONLY BY WRITTEN LICENSE *) 

(* OBTAINED FROM THE INSTITUTE FOR INFORMATION SYSTEMS. *) 

(* *) 
( ****** ************************************************************ ) 
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1 

1 PROGRAM PASCALSYSTEM; 

1 

1 (************************************************) 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 CONST 

1 MMAXINT r 32767; 

1 MAXUNlT = 12; 

l maxdiR = 77! 

1 VIDLENG = 75 

1 TIDLENG s 15; 

i maxseg = is; 



* ♦ ) 

* UCSD PASCAL OPERATING SYSTEM *) 

* ♦ ) 

* RELEASE LEVEL: i.3 AUGUST* 1977 *<) 

* 1.4 JANUARY, 1978 ♦ ) 

* 1.5 SEPTEMBER, 1978 *) 

* II. FEBRUARY, 1978 BD *) 

* *) 

* WRITTEN BY ROSER T, SUMNER *) 

* WINTER 1977 *) 

* *) 

* INSTITUTE FOR INFORMATION SYSTEMS *) 

* UC SAN DIEGO, LA JOLLA, CA *) 

* *) 

* KENNETH L. BOWLES, DIRECTOR ♦ ) 

* *) 

*********♦**************************************) 



(♦MAXIMUM INTEGER VALUE*) 

(♦MAXIMUM PHYSICAL UNIT ft FOR UREAD^) 

(♦MAX NUMBER OF ENTRIES IN A DIRECTORY^) 

{♦NUMBER OF CHARS IN A VOLUME ID^) 

(♦NUMBER OF CHARS IN TITLE ID^> 

(♦MAX CODE SEGMENT NUMBERS) 
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F3UKSIZF: = 512; 
0IR3L.K = 2? 
AGtLJMir = 300; 

f:cl = lji 

ull = is; 

NA'Mr_LEN = 
FILlIlE'J = 



TYPE 



235 

n; 



(♦STANDARD DISK BLOCK LENGTH*) 

(♦DISK ADDR OF DIRECTORY*) 

{♦MAX AGE FOR GDIRP...IN TICKS*) 

(♦END-OF-LINE.. .ASCII CR*) 

(♦BLANK COMPRESSION CODE*) 

CLENGTH OF CONCAT ( VIDLENG i • : • «TIDLENG ) 3 

CMAXIMUM it OF NULLS IN FILLER! 



IORSLTWD = 



(IN0rRK0R,IBADBL0CK.I3ADUNlT,IBADM0DE.ITIME0UT. 
ILoItUNIT.ILOSTFILE.IBADTITLE.INOROOM.XNOUNIT. 
INOFlLE,IDUPFlLE.INOTCLOSED,INOTOPENtIBADFORMAT, 

ISTRGOVFL) 5 

{♦COMMAND STATES... SEE GETCMD*) 

CMDSTATE = ( HALTlNIT , DEBUGCALL* 

UPROGNOU,UPROGUOKiSYSPROGi 
COMPONLY ♦ COMPANDGO t COMPDEBUG t 
LlNKANDGOiLlNKOEBUG) ; 

(♦CODE FILES USED IN GETCMD^) 
SYSFILE = (ASSMBLER,COMPILER*EDITOR,FILERiLINKER)5 

(♦ARCHIVAL INFO... THE DATE*) 



DATEREC = PACKED RECORD 

MONTH: 0..12; 

day: o.,3i; 
year: 0..100 
end (*daterec*) 



UNITNUM = 0..MAXUNIT? 
VID = STRINGCVIDLENGD! 

OIRRANGE = 0..MAXDIR; 
TID = STRINGCTIDLENG35 



(♦0 IMPLIES DATE NOT MEANINGFUL^) 

(♦DAY OF MONTH*) 

(♦100 IS TEMP DISK FLAG*) 



(♦VOLUME TABLES^) 



(♦DISK DIRECTORIES^) 
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FJL.L_.nJ = STKINGC NAME-LEND; 

FlLE_TAdLE = ARRAY CSYSFILED OF FULL-ID; 



FILEKlMO r 



(JNTYPEOFILEtXDSKFlLEiCOOEFILEiTEXTFILEt 
INFOFlLE,DATAFlLE.GKAFFlLE.FOTOFILE,SECUREDIR) ; 



direntry = packed record 

dfirstblk: integer; 
dlastblk: integer; 
case dfkind: filekind 
securedir, 
untypedfile: (*only in 

(FILLER1 : 0..2048; 

dvid: vid; 
deovblk: integer; 



(*FIRST physical disk ADDR*) 
(♦POINTS AT BLOCK FOLLOWING*) 
OF 



DIRCO}.. .VOLUME INFO*) 

CFOR DOWNWARD COMPATIBILITY , 13 BITSD 

(*NAME OF DISK VOLUME*) 

(♦LASTBLK OF VOLUME*) 



DNUMFILES: DIRRANGE5 (*NUM FILES IN DIR*) 
DLOADTIME: INTEGER? (*TIME OF LAST ACCESS*) 
DLASTBOOT: DATEREC); (*MOST RECENT DATE SETTING*) 

XDSKFILE»C0DEFILE,TEXTFILE«INF0FILE, 

DATAFILE«GR AFFILE «FOTOFILE: 



END 



(FILLER2 : 0..1024; CFOR 
STATUS : BOOLEAN; 
dtid: TIO; 

dlastbyte: l.fblksize; 
daccess: daterec) 
(♦direntry*) 5 



DOWNWARD COMPATIBILITY] 

CFOR FILER WILDCARDS!] 
(*TITLE OF FILE*) 
(*NUM BYTES IN LAST BLOCK*) 
(*LAST MODIFICATION DATE*) 



DIRP = ^DIRECTORY! 



DIRECTORY = ARRAY CDIRRANGE3 OF DIRENTRY; 

(*FILE INFORMATION*) 

CLOSETYPE = (CiMORMAL,CLOCKiCPURGEiCCRUNCH) 5 
WINDOWP = '"WINDOW; 

WINDOW = PACKED ARRAY C0..0D OF CHAR; 
FI3P = *FIB! 



FIB = RECORD 

FWINDOW; WINDOWP; 



(*USER WINDOW. ..F~» USED BY GET-PUT*) 
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FEOF, 
FSTAT 
FKECS 
CASE 
TRU 



FEOL 

t: ( 

ize: 
fiso 
e: ( 



N: tiOOLE 

(- JAMDW»F 

INTEGER 

hen: 300 
fisblkd: 
funit: u 
fviq: vi 
kreptcnt 

FNXTBLK, 
FMAXBLK: 
FMODIFIE 
PHEADER: 
CASE FSO 

true: 



AN; 

NEEDCHARiFG 
; (*IN BYTE 
LEAN OF 
BOOLEAN 

nitnum; 
d; 



OTCHAR) ? 
S...0=>BLOCKFlLEi 



1=>CHARFILE*) 



( 
( 
( 
I 
( 

integer; ( 
diboolean; ( 

direntry; ( 
ft3uf: bool 

(FNXTBYTEtF 

fsufchngd: 
fbuffer: p 



END (*FI8+) 



♦FILE IS ON BLOCK DEVICE*) 

♦PHYSICAL UNIT ft*) 

♦VOLUME NAME*) 

♦ U TIMES F- VALID W/O GET*) 

♦next rel block to 10*) 
♦max rel block accessed*) 
♦please set new date in close*) 
♦copy of disk dir entry*) 
eaim of (*disk get-put stuff*) 
maxbyte: integer; 
boolean; 
acked array c . .fblksized of char)) 



(♦USER WORKFILE STUFF*) 



INFOREC = RECORD 

SYMFIBP»C0DEFI3P: fibp; 

errsym,errblk»errnum: integer; 
slowterm, stupid: boolean; 
altmode: char; 
gotsym,gotcode: boolean; 
workvid,symvid«codevid: vid; 
worktid»symtid»codetid: tid 
end (*inforec*) ; 



(♦WORKFILES FOR SCRATCH*) 
(♦ERROR STUFF IN EDIT*) 
(♦STUDENT PROGRAMMER ID!!*) 

(♦WASHOUT char for compiler*) 

(♦TITLES ARE MEANINGFUL*) 
(♦PERM&CUR WORKFILE VOLUMES*) 
(♦PERM&CUR WORKFILES TITLE*) 



segrange = 0..maxseg; 
segdesc = record 

diskaddr: integer; 

codeleng: integer 

END (*SEGDESC*) ; 



3YTERANGE = 0..255; 



(♦CODE SEGMENT LAYOUTS*) 



(♦REL BLK IN CODE...ABS IN SySCOM**) 
(♦« BYTES TO READ IN*) 



(♦DEBUGGER STUFF*) 
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TRICKAHRAY = RlCOKD MEMORY DIDDLING FOR EXECERRORD 
CASE BOOLEAM OF 

TRUE : (WORD : ARRAY CO. .01 OF INTEGER); 
FALSE : (3YTE : PACKED ARRAY CO. .03 OF 3YTERANGE) 
END; 
MSCrtp = ~ MSCW; (*MARK STACK RECORD POINTER*) 

MSC* = RECORD 

statlink: MSCWP; (*POINTER TO PARENT MSCW*) 

dynlink: mscwp; (*pointer to caller's mscw*) 
msseg.msjtab: "trickarray; 
msipc: integer; 
localdata: trickarray 

END (*MSCW*) ; 

(♦SYSTEM COMMUNICATION AREA*) 



syscomrec = record 

iorslt; iorsltwd5 
xeqerr; integer; 
sysunit: unitnum; 

BUGSTATE: INTEGER! 

gdiRp: dirp; 
lastmp,stkbase,bombp: 



(♦SEE INTERPRETERS. ..NOTE *) 
(*THAT WE ASSUME BACKWARD *) 
(♦FIELD ALLOCATION IS DONE ♦ ) 



memtop.seg.jtab: integer; 



(♦RESULT OF LAST 10 CALL*) 
(♦REASON FOR EXECERROR CALL*) 
(♦PHYSICAL UNIT OF BOOTLOAD*) 
(♦DEBUGGER INFO*) 
(♦GLOBAL DIR POlNTERtSEE VOLSEARCH*) 

mscwp; 



(♦WHERE XEQERR BLOWUP WAS^) 

(♦MORE DEBUGGER STUFF^) 

OF INTEGER; 

(♦DRIVERS PUT RETRY COUNTS^) 

61 OF INTEGER; 



BOMBIPc: INTEGER; 
hltline: INTEGER; 
BRKPTS: ARRAY CO. .3D 
retries: INTEGER! 
expansion: array co..< 
hightime,lowtime: integer; 
miscinfo: packed record 

nobreak, stupid, slowterm, 

HASXYCRT,HASLCCRT t HAS85X0A,HASCLOCKI BOOLEAN; 
USERKIND: (NORMAL* AQUIZ, BOOKER, PflUIZ); 
IS_FLIPT ; BOOLEAN 

END; 

crttype: integer; 
crtctrl: packed record 

rlf,ndfsteraseeol,eraseeos, home, escape: char; 
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VAR 



OF BOOLEAN 



backspace: char; 
fillcount: 0..255; 
clearscreen, clearline; char; 
prefixed: packed array co. .83 

END; 

cktinfo: packed record 

width, height: integer; 

right, left, down, up: char5 

badch,chardel, stop, break, flush, eof: char; 

altmode,linedel: char; 

backspacefetx, prefix: char; 

prefixed: PACKED ARRAY CO. .133 OF boolean 
end; 
segtable: array csegrange3 of 

RECORD 

codeunit: unitnum; 
codedesc: segdesc 

END 
END (*SYSCOM*); 



MISCINFOREC = 



RECORD 

msyscom: 
end; 



SYSCOMREC 



syscom: ^syscomrec; 

gfiles: array co. .53 of fibp5 

userinfo: inforecj 

emptyheap: ^integer; 

inputfib,0utputfib« 

systerm,swapfib: flbp; 

syvid,okvid: VIO; 

thedate: DATEREC; 

DEBUGINFO: "INTEGER; 

STATE: CMDSTATE; 

PL: STRING; 

IPOT: ARRAY CO. .43 OF INTEGER; 

FILLER: STRINGCFILL_LEN35 

digits: set of •o , ..»9' ; 

UNITABLE: ARRAY CUNITNUM3 OF (*0 
RECORD 



{♦MAGIC PARAM...SET UP IN BOOT*) 
(♦GLOBAL FILES* 0=INPUT. l=OUTPUT*) 
(♦WORK STUFF FOR COMPILER ETC*) 
(♦HEAP MARK FOR MEM MANAGING^) 
(♦CONSOLE FILES. ..GFILES ARE COPIES+) 
(♦CONTROL AND SWAPSPACE FILES*) 
(♦SYSUNIT VOLID & DEFAULT VOLID+) 
(♦TODAY. ..SET IN FILER OR SIGN ON*) 
(♦DEBUGGERS GLOBAL INFO WHILE RUNIN+) 
(♦FOR GETCOMMAND^) 

(♦PROMPTLINE STRING. ..SEE PROMPT^) 
(♦INTEGER POWERS OF TEN*) 
(♦NULLS FOR CARRIAGE DELAY+) 

NOT USED+) 
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uvid: vio; (*volume id for unit*) 
case uisblkd: boolean of 
true: (ueovslk: integer) 
end (*unitable*) ; 
filename : file_tat*le; 

(* -- 

(* system procedure forward declarations *) 
{* these are addressed by object code... *) 
(* do not move without careful thought *> 

procedure execerror; 

FORWARD; 



•*) 



finituar f: fib; window: windowp; recwords: integer)? 
freset(var f: fib) ; 



PROCEDURE 

FORWARD 
PROCEDURE 

FORWARD 

PROCEDURE FOPEN(VAR f: FIB! VAR FTITLE: STRING; 

fopenold: boolean; JUNK: FIBP); 

FORWARD 
PROCEDURE FCLOSE(VAR FI FIB; FTYPE: CLOSETYPE); 

FORWARD 
PROCEDURE 

FORWARD 
PROCEDURE 

FORWARD 
PROCEDURE 



FGETUAR F: FIB) ; 
FPUKVAR F! FIB); 

xseek; 



FORWARD 
FUNCTION FEOF(VAR F: FIB): BOOLEAN; 

FORWARD 
FUNCTION FEOLN(VAR F: FIB): BOOLEAN; 

FORWARD 
PROCEDURE 

FORWARD 
PROCEDURE 

FORWARD 
PROCEDURE 

FORWARD 
PROCEDURE 

FORWARD 
PROCEDURE FREADCHAR(VAR F: FIB; VAR CH: CHAR); 



FREADINTtVAR F: FIB; VAR I: INTEGER)? 
FWRITEINTUAR F: FIB; ItRLENG: INTEGER); 
XREADREAL; 
XWRITEREAL; 
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3 FORWARD 

i procedure: 

4 FORwARj 

i procedure: 

4 FORw'ARD 
1 PROCEDURE 

4 FORWARD 
1 PROCEDURE 

5 FORWARD 

1 PROCEDURE 

2 FORwARO 

1 PROCEDURE 

2 FORWARD 
1 PROCEDURE 

4 FORWARD 
1 PROCEDURE 

5 FORWARD 
1 PROCEDURE 
5 FORWARD 
1 PROCEDURE 



FWRITEXHArt<VAR FJ FIB; CH: CHAR; RLENG: INTEGER)! 
FREADSTRIiMGCVAR F: FI3J VAR S: STRING; SLENG: INTEGER); 
FWRITESTRIfjGCVAK FZ FIB; VAR S: STRING; RLENG; INTEGER); 
FWRITEBYTES(VAR F: FI3; VAR A: WINDOW! RLENG.ALENG: INTEGER); 
FREADLNtVAR F: FIB) ; 
FWRITELN(VAR F: FIB) ! 

SCONCAT(VAR DESTiSRc: STRING! DESTLENG; INTEGER)! 
SINSERT(VAR SRC, DESK STRING; DESTLENG, INSINX; INTEGER); 
SCOPY(VAR SRC.DEST: STRING! SRCINX ,COPYLENG: INTEGER)! 
SDELETE(VAR DEST! STRING? DELINX,DELLENG: INTEGER)! 



4 FORWARD; 
3 FUNCTION SPOS(VAR TARGET, SRC: STRING)! INTEGER! 

5 FORWARD! 
3 FUNCTION FBLOCKIO(VAR F: FIB! VAR A: WINDOW! I! INTEGER! 

6 N8I_0CKS,RBL0CK: INTEGER; DOREAD: BOOLEAN): INTEGER; 
9 FORWARD! 

1 PROCEDURE FGOTOXY(X,Y: INTEGER)! 

3 FORWARD! 

3 

3 (* NON FIXED FORWARD DECLARATIONS *) 

3 

3 FUNCTION V0LSEARCH(VAR FVID: VID! LOOKHARD: BOOLEAN; 

5 VAR fdir: dirpj: unitnum; 

6 FORWARD; 

1 PROCEDURE WRITEDIR(FUNIT: UNITNUM; FDIRJ DIRP)! 

3 FORWARD; 

3 FUNCTION DIRSEARCH(VAR FTlD: TID! FINDPERMl BOOLEAN! FDIR: DIRP): DIRRANGE! 

6 FORWARD! 

3 FUNCTION SCANTITLE(FTITLE: STRING; VAR FVID: VID; VAR FTID: TID! 
6 VAR FSEGS: INTEGER! VAR FKIND: FILEKIND): BOOLEAN; 

49 FORWARD; 
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34 
34 
3 5 
35 
36 
36 
37 
37 
38 
38 
39 
39 
40 
40 
41 
41 
42:D 

42:d 

43:D 
43ID 

43:d 

43ID 

43:d 
43:q 

43ID 

43:d 

43IU 

43:d 
43:d 
43:d 

43ID 

43:d 
43:d 

43!D 

43:d 
43:d 
43:d 
43:o 

43:D 

43:d 

43:d 



i procedure delentryifinx: dirrange; fdik: dirp>; 

3 FORWARD; 

1 PROCEDURE INSENTRYWAR FENTRY: DIRENTRY; FINX: DIRRANGE; FDIR; DIRP); 

4 FORWARD; 

1 PROCEDURE HOMECURSOR; 

1 FJRWARD; 

1 PROCEDURE CLEARSCREENJ 

1 FORWARD; 

1 PROCEDURE CLEARLINE; 

1 FORWARD; 

1 PROCEDURE PROMPT; 

1 FORWARD; 

3 FUNCTION SPACEWAITIFLUSH: BOOLEAN): BOOLEAN? 

4 FORWARD; 

3 FUNCTION GETCHAR(FLUSHI BOOLEAN): CHAR; 

4 FORWARD; 

3 FUNCTION FETCHDIR(FUNIT:UNITNUM) : BOOLEAN; 

4 FORWARD; 

1 PROCEDURE COMMAND; 

1 FORWARD; 

1 

1 

1 C*I GLOBALS.TEXT3 

1 C$1 FILER. VARS.TEXTJ 

1 c ******************************** ************** 

1 c 

1 C UCSD PASCAL FILEHANDLER 

1 C 
1 c 
1 c 
1 c 
1 c 
1 c 
1 c 
1 c 
1 c 
1 c 
1 c 
1 c 
1 c 
1 L 



RELEASE LEVEL: II. FEBRUARY* 1979 



WRITTEN BY ROGER T. SUMNER 

RELEASE LEVEL 1.4, WINTER 1977 

WRITTEN BY STEVEN S THOMSON 

RELEASE LEVEL F.5A SUMMER 1979 
RELEASE LEVEL II. WINTER 1978-79 

INSTITUTE FOR INFORMATION SYSTSEMS 
UC SAN DIEGO, LA UOLLA, CALIFORNIA 
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43 :o 
43:c 

43:j 
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■ l: 
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I KENNETH L. BOWLES t DIRECTOR 1 

I 1 

l******** + *******#*+**** ************** * * *******j 



Z COPYRIGHT (C) 1979 REGENTS OF THE UNIVERSITY OF CALIFORNIA. 

C PERMISSION TO COPY OR DISTRIBUTE THIS SOFTWARE OR DOCUMEN- 

Z TATION IN HARD OK SOFT COPY GRANTED ONLY BY WRITTEN LICENSE 

C OBTAINED FROM THE INSTITUTE FOR INFORMATION SYSTEMS. 



SEGMENT PROCEDURE FILEHANDLER ( ZZZZZ ,ZZZZZZ : INTEGER); 



CONST 

DIRLAST3LK 
MAXTITLE 

VOLONLINE 

TEXTLOST 

CODELOST 

FOUNDFILE 

BLKDEXP 

UNBLKDEXP 

FILEEXP 



TYPE 

UNTYPED = 

TIDRANGE = 

MATCHES = 

LOCATION = 

CHECKS = 



6; 


DUPDIRLASTBLK 


- 


10; 


SHSTRLENG 


40; 


HALFMAXDIR 


- 


39; 




10135 


FILEUNBLKDEXP 


- 


1020; 


NOWRK 


1014! 


FILEBLKDEXP 


— 


1021; 


NOWILD 


1015! 


FILEVOLEXP 


- 


1022; 


BADFORM 


1016! 


VOLEXP 


s 


10235 


ILLFILEVOL 


10175 


FILEFULL 


= 


1024; 


ILLCHANGE 


10185 


WRKSAVED 


s 


1025; 


BADDEST 


10195 


NODIR 


= 


10265 


BLKD 
UNBLKD 



1027; 
1028; 
1029; 
1030; 
1031; 
10325 
1033; 
103 4 *; 



file; 

0..TIDLENG; 

(FILEFOUND, NOFlLESt FILESNOGOOD. ABORTIT) 
(SOURCE, DESTlNATlONtNEITHER) ; 
(BADTITLE* BADUNlTt NOVOLt BADDIR. 
BADFlLEt UNBLKDVOL. OKDIR, OKFILE); 



CHCKS 



= SET OF checks; 



LONGSTRING 
SHORTSTRING 



= STRINGC2553; 

= STRINGCSHSTRLENSJ; 
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1! 
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10 
10 
16 
16 
17 
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20 
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26 
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STRNG 

ABLOCK 

BITMAP 



= stringlmaxtitle3s 

= array l0..255] of integer; 

= packed record 

direntry : packed array cqirrange3 of boolean; 
entries : dirrange; 

END; 



UAR 

GBUFBLKS 

SOURcEJNlT, DESTUNlTi 

GUNIT 



CH 

GDIR 
LFIBP 

FAST, 

MARKING, 

QUESTION* WILDCARD, 

TEXTSAVED» CODESAVED 



LASTSTATE 
FOUND 

GBUF 

GKIND 

DIRMAP 

BLOCKPTR 
LFIB 



INTEGER; 

UNITNUM; 
CHAR; 

DIRP; 
FIBP; 



: BOOLEAN; 

: checks; 

: matches; 

: WINDOWP; 

: filekind; 

: bitmap; 

: a ablock; 

: untyped; 



c blocks available in transfer buffer 

C UNITS RELATED TO SOURCE & DEST. FILES 
C UNIT U THAT LAST VOLSEARCH RETURNED 



C GENERAL PURPOSE CHARARCTER 

C POINTER TO THE DIRECTORY IN USE 

C POINTER TO THE HEADER OF FILE LFIB 

C SYSCOM* CNOT SLOWTERM & (WIDTH > 79)3 

C MUST USE STATUS BIT IN DIRECTORY 

C IS WILDCARD OPTION BEIN6 USED ? 

C WORKFILES SAVED ? 



C STATE OF LAST CALL TO SCANINPUT 
C RESULT OF DIR. SEARCH FOR A FILE 

C POINTER TO THE TRANSFER BUFFER 

C FILETYPE (E.G., TEXT, CODE, DATA. .. ) 

C KEEPS TRACK OF THE FILES TO BE USED 
C IN A WILDCARD OPERATION 

C POINTER TO ONE-BLOCK OF DATA 

C GENERAL PURPOSE FILE 
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2: 
2; 
2; 
2; 



2:d 
3:o 
3:d 
3:d 
3:o 



6 7 
37 
6 7 
Hi 
c 7 
67 
67 
91 
91 
51 
91 
91 
123 
123 
149 
174 
191 
233 
361 
361 
361 
361 
361 
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361 
361 
361 
1 
1 
1 
1 
1 
3 
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VOLfJAMU* VOLNAME2. 

DESTVlj, SOURClVIO, 

GVID. 
GVID2 



SOURCETITLE, 

STRINGS, STRING4. 
GTID 



STRING1, STRING3 

MONTHSTR 

TYPESTR 

FROMWHERE, TOWHERE 

INSTRlNG 



VID! 



tid; 

shortstring; 
stringc4b3; 

STRINGC323; 

STRNG! 

LONGSTRING; 
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C VOLUME NAMES OF SOURCE & DESTINATION 3 

C FILES RESPECTIVELY. AS INPUTTED 3 

I EXPLICIT VOLUME NAME ASSOCIATED WITH 3 

C SOURCE 8 DEST UNITS RESPECTIVELY 3 

C LAST VOLNAME RETURNED BY SCANIPUT 3 

l LAST VOLNAME ENTERED INTO SCANIPUT 3 



C SOURCE FILE WITH EXLICIT VOLUME NAME 3 
C SUFFIX STRINGS TO WILDCARDS 3 

C LAST TITLE RETURNED BY SCANIPUT 3 



C PREFIX STRINGS TO WILDCARDS 

C CONTAINS ABBR. FOR THE MONTHS 

C CONTAINS ABBR. FOR THE FILE TYPES 

C SOURCE & DESTINATION FILES 

C INPUT STRING 



3 
3 
3 
3 
3 



C$1 FILER, VARS.TEXT3 

C$1 FILER,A.TEXT3 

C COPYRIGHT (C) 1979 REGENTS OF THE UNIVERSITY OF CALIFORNIA. 

C PERMISSION TO COPY OR DISTRIBUTE THIS SOFTWARE OR DOCUMEN- 

r IS 11 ?. IN HARD ° R S0FT C0PY GRANTED ONLY BY WRITTEN LICENSE 
C OBTAINED FROM T HE INSTITUTE FOR INFORMATION SYSTEMS. 



3 
3 
3 
3 



c*******************************^**********^^ 

r ln l n pR ° CDURE IS CALLED IN AN INFINITE LOOP. USED TO EXIT FROM WHEN AN 3 
PROCEDURE cSlLPROc! 8 ENC ° UNTERE °- WILL RETURN T0 "AIN FILER PrSmP^LINE 3 

FORWARD; 



c the C hea P Se r CE o D f UR th a U t SE f D il T e° f?bp GE A P ° INTER T ° A UNTYPed file to * p0INTER T0 = 

FUNCTION GETPTR(VAR DUMMY : UNTYPED) I FIBP; C DUMMY IS PLACED ON THE STACK 3 
8eJin X : ARRAY C ° ,,0:I ° F FIBP! C TRIX IS PLACED ° N THE STACK 3 
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1 


3:1 





491 


1 


3:0 


■3 


49^ 


1 


Z • • | 


22 


49.5 


1 


5'.U 


22 


494 


1 


3:o 


22 


495 


1 


3:o 


22 


496 


1 


3:o 


22 


497 


1 


4:0 


1 


496 


1 


4:o 





499 


1 


4:1 





500 


1 


4:i 


7 


501 


1 


4:1 


15 


502 


1 


4:i 


22 


503 


1 


4:1 


29 


504 


1 


4:i 


36 


505 


1 


4:i 


44 


506 


1 


4:i 


51 


507 


1 


4:1 


58 


508 


1 


4:i 


66 


509 


1 


4:i 


73 


510 


1 


4:i 


80 


511 


1 


4:i 


83 


512 


1 


4:1 


86 


513 


1 


4:i 


89 


514 


1 


«*:i 


92 


515 


1 


4:i 


95 


516 


1 


f:o 


102 


517 


1 


4:0 


114 


518 


1 


4:o 


114 


519 


1 


4:o 


114 


520 


1 


4:o 


114 


521 


1 


4:o 


114 


522 


1 


5:d 


1 


523 


1 


5:d 


3 


524 


1 


5:d 


3 


525 


1 


5:o 





526 


1 


5:1 





527 


1 


5:i 


7 


528 


1 


5:i 


7 


529 


1 


5:i 


7 


530 


1 


5:1 


10 



GETPTR := TRIXC-i 1 

END; 



C WE ACCESS DUMMY AS TYPE FIBP 3 






C INITIALIZES GLOBAL VARIABLES FOR THE FILER J 

PROCEDURE INITGLOBALS; 

BEGIN 

GVID := ••; 

STRlNGl 

STRING2 

STRING3 

STRING** 

TOWHERE 

VOLNAME1 

V0LNAME2 

FROMwhERE ;= 

SOURCEVID := 

DESTVID := "; 

sourceunit := 0; 

DESTUNIT :r 0; 

found := nofiles; 
wildcard := false; 
question := false! 
fillchar(dirmap,sizeof(dirmap),0) 

END; 



»'; 



FILER ERROR MESSAGES 



C WRITES OUT MOST FILER RELATED AND I/O ERRORS. IF NUMBER <> 
C THEN THIS PROCEDURE WILL RETURN TO THE FILER PROMPT LINE 
PROCEDURE MESSAGES(NUMBER : INTEGER; EXXIT : BOOLEAN); 
VAR 

STR ; STRINGC403; 
BEGIN 

STR ;= »»; 



AND 



EXXIT 1 
2 



C I/Q errors 

CASE NUMBER OF 

1 : STR := 'PARITY (CRC) ERROR'; 
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541 
532 
533 
534 
535 
536 
537 
53a 
539 
540 
541 
542 
543 
544 
545 
546 
547 
548 
549 
550 
551 
552 
553 
554 
555 
556 
557 
558 
559 
560 
561 
562 
563 
564 
565 
566 
567 
568 
569 
570 
571 



1 

1 
i 
1 
1 

-1 
X 

1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 



b; 
5: 
5: 
5: 

5: 
5: 
5; 
5: 
5; 
5: 
5: 
5: 
5: 
5; 
5; 
5: 
5: 
5: 
5; 
5: 
5: 
5; 
5; 
5: 
5: 
5; 
5: 

5! 

5: 
5: 
5; 
5: 
5: 
5: 
5: 
5: 
5; 
5; 
5; 
5; 
5 



37 
SI 
37 
1G9 
135 
160 
162 
2C5 
233 
256 
284 
234 
284 
287 
315 
338 
361 
380 
397 
415 
433 
459 
483 
500 
517 
542 
568 
596 
624 
653 
701 
731 
775 
777 
860 
871 
906 
909 
929 
958 
960 



2 
3 
4 
5 
6 
7 
8 
9 
10 

end; 



; st^< : 


; sir : 


: str : 


: str : 


: st< : 


: str : 


: str : 


: str : 


: str : 



'BAG UNIT NUMBER' J 
•BAD I/O OPERATION' ; 
•TIMEOUT ERROR' ; 
♦VOL WENT OFF-LINE' 5 
•FILE LOST IN DIR' ! 
•BAD FILE NAME» J 
•NO ROOM ON VOL' ; 
•NO SUCH VOL OM-LINE' J 
•FILE NOT FOUND 1 ; 



CASE NUMBER 

1013! STR 

1014: STR 

1015: STR 

1016: STR 
1017«1033; 
I0l8tl034: 

1019: STR 

1020: STR 

1021'. STR 

1022: STR 

1023: STR 

10241 STR 

1025: STR 

1026: STR 

1027: STR 

1028: STR 

IO29: STR 

1030: STR 

I03i: STR 

IO32: STR 

end; 

if number 1 
str := co 
clearline; 
if (number 

WRITE* '1/ 
ELSE 

WRIT£(STR 



• FILER RELATED ERRORS 

IF 
- t 

= t 

= t 



VOL ALREADY ON-LINE 1 ; 

TEXT FILE LOST' ; 

CODE FILE LOST'? 
;= 'FILE FOUND* 5 
STR := •BLKD VOL'; 
STR 1= •UBLKD VOL'; 
:= 'FILE NAME' i 
;= 'FILE/(UNBLKD VOL)'; 
;= »FILE/(BLKD VOD'5 
!= »FILE/V0L'5 
:= 'VOL NAME'; 
;= 'OUTPUT FILE FULL'; 
;= 'WORKFILE IS SAVED' ; 
!= 'NO DIRECTORY ON VOL'; 
;= »NO WORKFILE TO SAVE'; 
;= 'WILDCARD NOT ALLOWED' { 

1= 'BAD FORMAT (WILDCARD <TO> NON-WILDCARD) • J 
;= 'ILLEGAL FILE/VOL NAME'; 
:= 'ILLEGAL CHANGE (VOL <TO> FILE) NAME'; 
1= 'BAD DEST FOR FILES FOUND' 

N C1017. .10233 THEN 
NCAT(STR*' EXPECTED'); 

> 10) AND (NUMBER < 1000) OR SYSCOM^.MISCINFO.SLOWTERM THEN 

ERROR #', NUMBER) C MISC. I/O ERROR. PRINT OUT ERROR # ONLY 1 

) J 



372 1 5:i 9b9 IF ExxIT THEN 

b7 * 1 b ^ 97id EXIT(CALLPROC) 

574 1 5:0 976 END ; 

575 i 5:0 996 

578 1 5:o " 8 C CHECKS FOR SELECTED I/O ERRORS. WILL PRINT OUT ERROR AND 3 

577 1 5'*0 396 C RETURN TO FILER PROMPT LINE IF ONE IS FOUND 1 

578 1 8 :t 1 PROCEDURE CHECKRSLT(RSLT : INTEGER); 

579 1 6:0 BEGIN 

580 l 8:1 IF (RSLT > 0) AND NOT (RSLT IN C13tl43) THEN 

581 1 6J2 13 MESSAGES(RSLTiTRUE) 
532 1 6:0 15 END; 

583 1 610 30 

584 1 6:0 30 r 



WIDELY USED COMMAND SEQUENCES 



585 1 6:0 30 

588 l 6:0 30 C PERFORMS A WRITELN FOLLOWED BY A CLEARLINE 3 

587 1 7:D 1 PROCEDURE WRITEANQcLEAR ; 

588 1 710 BEGIN 

5 Q 9 1 7:i WRITELN! 

59 1 7:i 6 CLEARLINE 

591 1 7J0 6 END; 

592 1 7:0 22 

H? J Z :0 22 C READS' A CHARACTER FROM INPUT. RETURNS TRUE IF THE CHARACTER WAS A (»Y»»»Y»)3 

lH J l : ,° n 22 C FA L-SE OTHERWISE. EXITS TO PROMPT LINE IF THE CHARACTER WAS AN <ESO. WILL 3 

" 5 1 7:o 22 C POSITION CURSOR A T START OF NEXT LINE IF ALL WENT O.K. T 

tV> l 8: D 3 FUNCTION NGETCHAR(FLUSH : BOOLEAN) : BOOLEAN; 

597 1 6:o BEGIN 

598 1 8!1 CH := GETCHAR(FLUSH); 

;?!? 1 8:1 8 IF (CH = SYSCOM^.CRTINFO.ALTMOQE) THEN 

600 1 fa J2 20 EXIT(CALLPROC); 

601 i 8 :i 2<+ ngetchar := ch = »y»i 

602 i 8 :i 29 if not eoln then 

603 1 812 40 WRITELN 

604 1 8:0 40 END; 

605 1 6:0 58 

606 1 8:0 58 



07 1 8:0 58 



C ASKS THE USER TO TYPE A SPACE TO CONTINUE. WILL RETURN TO THE FILER PROMPT 3 

cnQ , a _ C LINE * F THE USER RESPONDS WITH AN <ESC>. IF FLUSH THEN PRECLUDES TYPE-AHEAD3 

608 1 9:D 1 PROCEDURE NSPACEWAlT ( FLUSH : 300LEAN); 

609 1 9:0 BEGIN 

610 1 9:1 IF SPACEWAIT(FLUSH) THEN 

611 1 9:2 8 EXIT(CALLPROC) 

612 1 9:0 12 END; 

77 



6ii i 9:0 2 : 4 

°1"+ 1 9:3 c<4 C USED TO UPDATE DIRECTORY AMD CHECKS THE I/O RESULT 3 

*15 1 10 :D l PROCEDURE UPDATEUlR? 

616 1 10 :0 3E3lfj 

617 1 10:1 u WRlTEClK(SOURCEUfjlT.GDlR) J 

*>ia i 10:1 5 chec<rslt(ioresjlt) 

bi9 1 10:0 7 END; 

620 1 10:0 22 

621 1 10:0 22 i MISCELLANEOUS GRUNDGE PROCEDURES 



622 1 10:0 22 

623 1 10:0 22 C REMOVES SPACES AND UNPRINTABLE CHARACTERS FROM INPUT STRING. 3 

624 1 10:0 22 C CHANGES ALL LOWER-CASE CHARACTERS TO UPPER-CASE 1 

625 1 11:0 1 PROCEDURE EATSPACES ( VAR STRG : LONGSTRING); 

626 1 ll:D 2 VAR 

627 i ii:d 2 I : integer; 

628 1 HID 3 

629 i 11:0 o begin 

630 i 11:1 o I := is 

631 1 ll:i 3 WHILE I <= LENGTH(STRG) DO 

632 1 11:2 10 IF (ORD(STRGCID) >= 33) AND (ORD( STRGC 1 1) <= 125) THEN 

633 1 11:3 23 3EGIN 

634 1 11:4 23 IF (STRGCID >= «A«) AND (STRGCI3 <= 'Z») THEN 

635 1 11:5 3b STRGCI3 := CHR( ORD( STRGCI3-) - ORD( »A» ) + ORD ( f A« ))| 

636 1 11:4 i+6 I := I + 1 

637 1 11:3 47 END 

638 1 11:2 51 ELSE 

639 1 11:3 53 DELETE(STRGtltl) ; 

640 1 ll:i 61 IF STRG = •• THEN 

641 1 11:2 69 EXIT(CALLPROC) ; 

642 1 ll:0 73 END; 

643 1 1110 88 

6^4 1 ll:o 88 C ASCERTAINS THE CORRECT BLOCK NUMBER FOR PROCEDURES TO USE AT A GIVEN TIME 2 

6^5 1 11:0 88 C IF A VALID OEOVSLK EXISTS ON THE PRESENT DIRECTORY THEN THE USER WILL BE D 

646 1 1110 88 C ASKED IF THAT VALUE IS THE CORRECT ONE. OTHERWISE A VALID BLOCK MUST BE 3 

647 1 ll:o 88 C ENTERED. FOR A BLOCK TO BE VALID IT MUST BE >= LASTBLK 3 

648 1 12ID 1 PROCEDURE GETBLOCKS (MESSl , MESS2 , MESS3 : SHORTSTRING! LASTBLK: INTEGER; 

649 1 12ID 5 VAR NBLOCKS: INTEGER); 

650 1 12:0 45 VAR 

651 1 12ID 45 OK : BOOLEAN; 
632 1 12:0 BEGIN 

653 1 12:1 OK := false; 



&bl+ i 12 :i is if g.-tir <> rjiL then 

& ' 3b X 1£: ^ -*3 IF GDIK-COD.DEOVBLK >= LASTBLK THEN 

656 1 12:5 52 -itolN 

657 1 12:4 32 CLEARLINE; 

653 1 12!** 55 WRlTE(MESSlt' » , GDIR~C 1. DlOVBLK t » »»MESS2,» ? (Y/N) •); 

659 1 12:*4 100 OK := NGETCHAR(TRUE); 

6o ° * 12 ^ 107 N3L0CKS := GDIR^COa.DEOVBLK 

661 1 12;3 H2 enD; 

662 1 12:1 114 i F NaT OK THEN 

663 1 12:2 119 BEGIN 

66*+ 1 12:3 119 clearline; 

665 1 12:3 122 WRlTE(MESS3t • ? • ) ; 

666 1 12:3 144 READLN(lMBLOCKS) 5 

667 1 12:3 157 IF NBLOCKS < LASTBLK THEN 

668 1 12:*+ 163 BEGIN 

669 1 1215 163 CLEARLINE! 

670 1 12:5 166 WRITECINVALID #')5 

671 1 12:5 185 EXIT(CALLPROC) 

672 1 12:*+ 189 END? 

673 1 12:2 189 END 
67*+ 1 12:o 139 END; 

675 1 12:0 202 

676 1 12:0 202 C ASCERTAINS IF THE USER REALLY WANTS TO DESTROY THE DIRECTORY OF A DISK 1 

677 1 12:0 202 C IF THE USER DOESN'T THIS PROCEDURE WILL RETURN TO THE FILER PROMPT LINE 1 

678 1 13:D 1 PROCEDURE RISKVOLUMEJ 

679 1 1310 BEGIN 

680 l 13 51 IF (LASTSTATE = OKDIR) AND (GDIR <> NIL) THEN 

68 1 1 13:2 9 BEGIN 

682 1 13:3 9 CLEARLINE; 

683 1 13:3 12 WRITE( 'DESTROY »,GVID, f : ? »); 
68*+ 1 13:3 53 IF NOT NGETCHAR(TRUE) THEN 

685 1 13:^ 61 EXIT(CALLPROC) 

686 1 13:2 65 END 

687 1 1310 65 END; 

688 1 13:0 78 

689 1 13:0 78 

690 1 13:0 78 C$1 FILER, A. TEXT] 
690 1 13:0 78 C$1 FILER. B. TEXT] 

til I IV 7& C COPYRIGHT (C) 1979 REGENTS OF THE UNIVERSITY OF CALIFORNIA. 3 

692 1 13:0 78 C PERMISSION TO COPY OR DISTRIBUTE THIS SOFTWARE OR DOCUMEN- 3 

° yi 1 13:0 78 C TATION IN HARD OR SOFT COPY GRANTED ONLY BY WRITTEN LICENSE 3 
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OBTAINED from T hl institute for information systems. 

SPECIALIZED. FILER ROUTINES 
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C ASCERTAINS WHETHER OR NOT THE PROPER DISK IS IN THE PROPER DRIVE 2 

C IF IT IS NOT WILL ASK USER TO PUT THE DISK IN THE PROPER DRIVE 3 

C IF THE USlR DOES NOT DO SO THIS PROCEDURE WILL RETURN TO THE 2 

L FIlER PROMPT LINE j 

PROCEDURE INSERTVOLUMEdNTUNIT : INTEGER? VID1 : VIDi CHECK : BOOLEAN); 
VAR 

ok : boolean; 

oloUnit, newunit : vio; 

BE3IN C INSERTVOLUMt" 2 
OLDU^JIT := *U »; 
IF (INTUNIT DIV 10) = 1 THEM 

0L0UNITC2D := »1»; 
OLDUr-jiT C33 := CHR«ORD<»0») + INTUNIT MOD 10)5 

eatspaces(oldunit) 5 
ok := check; 

if check then c need to make sure the disk is in the drive 2 
if v0l3earch(vid1»true»gdir) <> intunit then c volume in proper drive 2 

C KLUDGE MMM FORCE THE OP-SYSTEM TO LOOK AT THE CORRECT UNIT 2 
L IF THERE ARE TWO VOLS WITH THE SAME NAME ON LINE IT WON'T BE 2 
l ABLE TO FIND THE ONE ON THE LOWER DRIVE OTHERWISE 2 

3EGIM C VOLUME WAS NOT IN PROPER DRIVE, WHERE IS IT ? 2 

newunit := oldunit; 

ok := volsearch(Newunit,true.gdir) <> o; c o means unit not found 2 

OK := OK AND (NEWUNIT = VIOl) C IS THIS THE CORRECT VOLUME ? 2 

end; 

IF NOT OK THEN 

C REPEAT THE ABOVE AFTER ASKING THE USER TO PUT IN THE CORRECT DISK 2 

BEGIN 

clearline; 

WRITELNCPUT •»VlDl. t : IN UNIT ', OLDUNIT) 5 
NSPACEWAIT(TRUL) ; 
IF CHECK THEN 
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73^ 
737 
738 
739 
740 

7m 

742 

743 

744 

745 

746 

747 

748 

74? 

750 

751 

752 
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754 

755 

756 

757 

758 

759 

760 

761 

762 

763 

764 

765 

766 

767 

768 

769 

770 

771 

772 

773 

774 

775 
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1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 
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l4.*4 

i ■+ : b 
14: z 
14:& 
14:4- 



14 
14 
14 
14 
14 
15 
15 
15 
15 
15 

15:2 
15:2 
15:2 
15:3 

1513 

15: 3 
15:4 
i5:s 
15:6 



15 
15 
15 
13 
15 
15 
15 
15 
15 
16 

16 :d 
16:d 
i6:o 
I6:i 
i6:i 
i6:i 
!&:? 



lol 

lbl 

175 
136 
13J 

190 
190 

202 

202 

202 

1 

9 

9 





14 

14 

14 

14 

20 

2 
25 
25 
41 
50 
62 
65 
65 
67 
67 
82 

3 2 
82 

3 
31 
31 




31 
37 
43 



BEGIN 

OK .*= <VOLSEAKCH(OLDUNIT»TRUEiGDIR) O 0); 
It- (NOT 0K> OR OLOJMIT <> VID1) THEN 
EXIT(CALLPROC) 

ENO 
EN j 
END C INSERTVOLUHE 1\ 

C SCANS THROUGH DIpMAP FOR FILES TO BE DELETED ANO UPDATES THE 
C DIRECTORY ON THE SOURCE UNIT CORRESPONDINGLY -) 

PROCEDURE ZAPENTRIES(DIRMAP : 3ITMAP; UPDATE : BOOLEAN); 

V AR 

loc : integer; 

BEGIN 

IF DIRMAP. ENTRIES > THEN 
BESIN 

C MAKE SURE THAT THE CORRECT DISK IS IN THE DRIVE 3 
INSERTV0LUME<S0URCEUNIT,S0URCEVID,TRUE); 

IF GDIR <> NIL THEN 
BEGIN 

FOR LOC := GDIR A C 3.DNUMFILES DOWNTO 1 DO 
IF DIRMAP.DIRENTRY CLOC3 THEN 

rr ll DnA ENr T Y(L0C ' G0IR,; C DELETES FlLE ^ LOC IN THE DIRECTORY 3 

UPDATEDIK c WRITES THE DIRECTORY OUT TO DISK 3 

END 
END; 



END; 

C PUR 
C FIL 
FUNCT 
VAR 

GFI 
BEGIN 
RES 
PUR 
IF 
3 



GES THE FILE REQUESTED BY NAME FROM THE DIRECTORY. IF THE 3 
E EXISTS AND MESS <> •' THEN WILL ASK YOU TO CONFIRM 3 

ion purgeit(name.mess : shortstring):boolean; 
3 : file; 

ET(GFIB.NAME) ; 

GEIT := IORESULT = 0; 

IORESULT = THEN C RESULT OF MEANS THAT THE FILE WAS FOUND 3 
E3IN 
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776 

111 

711} 

7 79 

780 

781 

782 

783 

784 

785 

786 

787 

788 

789 

790 

791 

792 

793 

794 

795 

796 

797 

798 

799 

800 

801 

802 

303 

304 

805 

306 

807 

808 

809 

810 

811 

812 

813 

814 

815 

316 



1 

I 

1 

1 

1 

1 

1 

i 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

i 

1 



16 

16; 

is: 

16: 

is: 

is: 

16: 

i&: 

16:6 

16:4 

16:3 

i&:3 

16:2 

i6:o 

is :o 

16 :o 

17 :d 
i7:o 



17 

17 

17 

17 

17 

17:2 

17:3 

I7:i 

17:0 

i7:o 

i7:o 

17: o 

i7:o 

i7:o 

i7:o 

17: o 

is :d 

is:d 

18 :d 

i8:o 

ibid 
is:d 
19:j 



4 3 
52 
b^ 
bb 
24 
102 
1U2 
105 
109 
109 
109 
115 
117 
119 
138 
138 
1 


13 
44 
58 
53 
62 
73 
93 
123 
136 
136 c 
136 
136 
136 
136 
136 
1 
3 
27 
27 
28 
29 
1 



END; 



CH 

END; 



IF M r :SS O •» THEN 
3L5IU 

clzarlit.jc; 

WRITEMESS* ' ••NAMEt' 
IF NOT ^IGETCHAR(TRUE) 
3LuIi\l 

PURGEUT := FALSE; 

exit(purgeit) 

end 
end; 
03e(gfis. purge) ; 

t-CKRSLT(IQRESULT) 



o ~> 



? •> 

THEN 



C USER DOES NOT WISH TO REMOVE THE FILE 3 



C LETS USER KNOW WHAT IS 

PROCEDURE PRINTMESSJVID1 
BEGIN 

clearline; 

WRITE(\/lDlt': , ,TlDl) ; 
IF (LENGTH(DEST) + 31) 

WRlTEANDCLEAR 
ELSE 

IF NOT SYSCOM-.MISCINFO.SLOWTERM THEN 

WRITEC»:24-(LENGTH(VID1)+LENGTH(TID1))); 

writelnc --> t fDEST) """' 

END; 



8EING DONE TO HIS FILE 1 

: VID; TIDl : TID; DEST : SHORTSTRING); 



> SYSCOM^.CRTINFO. WIDTH THEN 



COMMAND PARSERS & DIRECTORY SEARCH ROUTINES 3 



C 
C 



PROCEDURE SCANINPUT(GTITLE : STRNG; CHECK TcHCKsJ D 

VAR ERR0R : INTEGER; WHERE : LOCATION; GETDIR : BOOLEAN)! 

NEWDIR : ^INTEGERS 
GSEGs : INTEGER; 



PROCEDURE MAKECALLCERR : INTEGER; STATE : CHECKS); 
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VAR 

prtntepkor : boolean; 

rlLGlrj 

LASTSTATE := STATE; 

IF (STATE IN CHECK) OR (ERROR = 0) THEN 

EXIT(SCANINPUT) ; 
IF GTITLE = •• THEN 

EXIT(CALLPROC) ! 
HOtfECURSOR; 
WRITEANDCLEAR; 

C WRITES OUT THE EXPLICIT VOLUME NAME 3 
IF GTITLE C13 = •*• THEN 
3EGIN 

DELETE(GTITLE, 1,1)5 

IF GTITLE C1J = »:• THEN 

DELETE(GTITLEil.l) J 
WRITE(SYVID» ':• ) 
END 

ELSE 

IF GTITLE C13 = •;• THEN 

WRITE(DKVID) * 

WRITE(GTITLE) ; 

IF SYSCOM^.CRTINFO, WIDTH >= 80 THEN 

WRITEC - ') 
ELSE 

WRITEANDCLEAR?. t WRITE STRING IN ERROR 3 
MESSAGES(ERRtFALSE); C WRITE THE STATE OF THE STRING 3 

C WAS THE USER EVEN CLOSE TO THE CORRECT FORMAT 3 
CASE STATE OF 

3AOTITLE : PRINTERROR := TRUE; 

NOVOLtBADUNlTtBADDIR : PRINTERROR := (ERR0R=FILEEXP) AND CGTlDs**)! 

JNBLKDVOL : PRINTERROR := ERROR IN CBLKDEXP, FILEEXP.FILEBLKDEXPD; 

0KFILE,BADFILE : PRINTERROR := ERROR IN CBLKDEXP,UNBLKDEXP» VOLEXP3 5 

OKDIR : PRlNTtRROR := ERROR IN CUNBLKDEXP.FlLEEXPtFILEUNBLKDEXPU 

eno; 

IF NOT SYSCOM^.MISCINFO.SLOWTERM THEN 
3EGIN 
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IF Pi<IilTE;{ROK THEN 
3EGIN 

IF SYSCU^.CRTINFO. WIDTH < 80 THEN 

WRITEANDCLEAR 
ELSE 

writeC »); 
mess ages (error. false) 
end; 

c jser may need to know which part of the string is in error 2 
if where = source then 

WRITEC <SOURCE>»)« 
IF WHERE = DESTINATION THEN 
WRITEC <DEST>»)5 

END? 

exit(callproc) 
end; 

begin c scaninput 1 

GUNlT := 05 

IF SCANTlTLE(GTlTLE,GVlD»GTlQiGSEGS,GKlND) THEN C BREAK UP INPUT STRING 2 

3EGIN 

IF GETOIK THEN 

MARK(NEWDIR) ! C WILL CAUSE THE PRESENT DIRECTORY TO DISSAPPEAR 2 
GVID2 := GVIDJ C SAVE PRESENT GVID 2 

GUNIT .*= VOLSEARCH(GVID.TRUEtGDlR) ; C SEARCHS FOR PROPER VOLUME 2 
IF GDIR = NIL THEN C WASN'T ABLE TO READ A DIRECTORY OFF THE VOLUME 
BEGIN 

IF GUNIT = THEN 

MAKECALL(9,N0V0L) ! C NO SUCH VOL WAS ON-LINE 1 
UNITCLEAR(GUNIT) J 
IF IORESULT <> THEN 

MAKECALH2.BADUNIT) ; C BAD UNIT U GIVEN 2 
IF UNITABLE C GUNIT 2. UISBLKD THEN 



MAKECALL(N0DIR»8ADDIR) ; 
MAKECALL(UNBLKD.UNBLKDVOL) 
END; 
IF GTID = ' • THEN 

MAKECALL(BLKUtOKDlR) ; C VOL 
IF DlRSEARCH(GTID,TRUEtGDIR) <> 
MAKECALL(FOUNDFILE.OKFILE) ; 



C VOL WAS BLKD. BUT NO DIR 
C VOLUME WAS NOT BLOCKED 2 



WAS BLKD & THE DIR IS OK 3 
THEN 
C THE FILE WAS FOUND J 



WAS ON IT 2 
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■-IAKECALL(lOtBAUFILE) C THE FILE WAS NOT FOUND 3 

MAKiCALL(ILLFILEvOL,BADTlTLE) C ILLEGAL NAME (TOO LONG. OR MISSING BRACKET J 
END C SCANINPUT 1; 



DIRECTORY SEARCH ROUTINE FOR FINDING THE USER REQUESTED FILES 
ON THE FIRST CALL TO THIS ROUTINE ALL TABLES AND NECCESSARY 
3ITS IN THE DIRECTORY WILL 3E UPDATED TO KEEP TRACK OF THE 
NESCESSARY FILES, WITHOUT LOSING ANY. ALL FILES THAT ARE TO 
BE USED IN WILDCARD OPERATIONS MUST BE PRESENT ON THE INITIAL 
INITIAL CALL TO THIS ROUTINE 
FUNCTION SEARCHDIR(MESSAGE : STRNGi VAR GINX I INTEGER; 

DEST» SCREENCLEAR : BOOLEAN) : BOOLEAN; 
VAR 

x : integer; 

NEWSTRING : TID; 

C AT THIS POINT A REQUESTED FILE HAS BEEN FOUND. IN CASE THAT 3 
C QUESTION IS TRUE WE MUST SEE IF THE USER STILL WANTS TO USE IT ] 
PROCEDURE FOUNDFILE; 
3EGIN 

WITH GDIR" CGINX] DO 
BEGIN 

SOURCETITLE := DTlD; 

FROMWHERE 1= CONCAT( VOLNAME1 , ♦ : • , DTlD ) ; 
CH := »Y«i 

FOUND := FILEFOUND; C YES A USABLE FILE HAS BEEN FOUND 2 
IF (MESSAGE <> ♦») AND QUESTION THEN C CONFIRM OPERATION 2 
BEGIN 

CLEARLINE; 

IF NOT SYSCOM^.MISCINFO.SLOWTERM THEN 

WRlTE(MESSAGEi • '); 
WRITE(DTlDt» ? '); 
CH := GETCHAR(FALSE) ; 
IF NOT EOLN THEN 

WRITELN; 
IF CH = SYSCOM^.CRTINFO.ALTMODE THEN C USER WANTS TO ABORT 2 

C DON'T RETURN TO PROMPT LINE BECAUSE OF THE R(EMOVE COMMAND 2 

BEGIN 

found := abortit; 
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C3D 



r".XlT(SEARCHDIR) 
EM -J 
END 
END; 
SEIARCHDIR := CH = »y» 
END; 

C CHECKS TO SEE IF THE REQUESTED PORTION OF THE TWO STRINGS MATCH 3 

FUNCTION! TESTSTRtSTR : TID5 START : INTEGER) : BOOLEAN; 

VAR 

temp : tid; 

3EGIN 

TEMP LQ1 := STR CO 3; 

UOVElEFKGDIR* CX3.DTlDCSTART3fTEMPClDiLENGTH(STR))! 
TESTSTR := TEMP = STR 
END; 

begin c searchdir 3 
searchdir := false; 
if ginx = then 

BEGIN 

OEST := DEST AND llNITABLE CDESTUNIT3.UISBLKD ; 
IF SCREENCLEAR AND WILDCARD THEN 
BEGIN 

CLEARSCREEN; 
WRITELN 

eno; 
found := nofiles; 

C WILL IT BE NESCESSARY TO USE THE STATUS BITS IN THE DIRECTORY 3 
C TO KEEP PROPER TRACK OF THE FILES 3 

MARKING := DEST AND (SOURCEVID = DESTVID); 

C SEARCH DIRECTORY FOR ELIGIBLE SOURCE FILES 3 
FOR X := 1 TO GDIR~ C03.DNUMFILES DO 
WITH GDIR A CXH DO 
BEGIN 

STATUS := FALSE; 

IF (LENGTH(STRINGl) + LENGTH ( STRING2 ) ) <= LENGTH(DTID) THEN 
IF TESTSTR(STRING1,1) AND 

TESTSTR(STRlNG2fLENGTH(DTID) - LENGTH! STRING2) + 1) THEN 
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WITH DIRMAP 00 

BEGIN c THIS FILE MATCHES THE NESCESSARY STRINGS 1 
IF (STRIMG1=DTI0) OR WILDCARD THEN 
BEGIN 

status := marking; 

DIRENTRY CX3 := TRUE; 
ENTRIES := ENTRIES + l; 

END; 
found := filesnogood 
end; 
end; 
if marking then 

END UP ° ATEDIR L " UST ^INTAIN THE STATUS BITS IN THE DIRECTORY J 
ELSE 

IF DEST THEN 

GINX := GINX - 1; 
IF DIRMAP. ENTRIES > THEN 
BEGIN 

INSERTJ/OLUME(SOURCEUNIT,SOURCE\/ID,TRUE); C GET THE SOURCE VOLUME ON-LINE 3 

WHILE (GINX < GDIR^COD.DNUMFILES) AND (CH <> »Y») DO 
WITH GDIR* CGINX+1D DO 
BEGIN 

GINX := GINX + l; C LOOK AT THE NEXT DIRECTORY ENTRY 3 

BEGIN 

DIRMAP. DIRENTRY CGINX3 := STATUS; 
IF STATUS THEN 
BEGIN 

UPDATEDIR FALSE; C TURN ° FF STATUS BIT IN DIR E*TORY 3 

END 
END; 

IF DIRMAP. DIRENTRY CGINX3 THEN 

BE ?p\,eT C T^ RCE FILE F ° R THIS ENTRY IS. O.K. WHAT ABOUT DEST 3 
+ 1 uc.c3 I THfc-N 

BEGIN 

NEWSTRING := COPY < DTlD» LENGTH < STRING1 ) + 1, 

LENGTH(DTID) - LENGTHCSTRING1 ) - LENGTH< STRING2) ) { 
X := LENGTH(NEWSTRING) + 
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S>CAU<LENGTri(STKING3) 1 = ' C » , STRING3C 1 3 ) + LENGTH ( STRING4 ) ? 
IF (X <= TIDLENG) AND ((X > 0) OR NOT WILDCARD) THEN 

t DESTINATION FILE WILL BE O.K. (ITS SMALL ENOUGH ) 3 
BEGIN 

TOWHERE := C0NCAT(V0LNAME2. • : » .STRING3, 

NEWSTRING.STRING4) I 
IF' (STRING1 = DTID) OR WILDCARD THEN 
FOUNDFILE 
END 
ELSE 

PRINTMESStSOURCEVlD.DTIDt 'NOT PROCCESSED» ) ! 
END 
ELSE 

foundfile; c no destination file is needed 2 
dirmap.direntry cginx3 := false; i turn off bit for this entry 2 
dirmap. entries := dirmap. entries - 1? c one less entry to do 1 
end; 
end; 
end; 
if found = nofiles then 

wessages(orddnofile) .false) 5 c no requested files were found 2 
if found = filesnogood then 
messages(baddest. false) 5 c the req. files found could not be used 3 
end c searchdir 3; 



L INPUT STRING PARSER. REMOVES WILDCARD SYMBOLS. 

C EXPANDS DOLLAR SIGNS. SETS SOURCEVID, DESTVlD. 

C VOLNAME1, V0LNAME2t STRING1. STRING2, STRING3. 

PROCEDURE CHECKFlLE(MSGl.MSG2 : SHORTSTRING; DEFAULT. ERRORl 

WILD.FILLE : BOOLEAN; CHECKl : CHCKS); 
VAR 

SRCSfR : STRING; 



SETS WILDCARD AND QUESTION 3 
SOURCEUNIT, DESTUNIT, 3 
STRING4 1 

INTEGER; 



c wi.l scan up to the next * .' or to the end of the line. does all »$• 3 
c expansions. parses string for wildcards. volname s filename. makes 3 
c su^e that the source and dest files are of the appropriate class and 3 
c th/\t needed volumes stay on line 3 

procedure processdata(Msg;shortstring; firstcalljboolean; var volname:vid; 

var firststr,secondstr:shortstring; var whereto:strng) ; 

VAR 
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str,olo : string; 
where : location; 
x.i.loc : integer; 

I MAKES SURE THAT THE STRUCTURE BEFORE THE LAST DELIMMITER IS OF THE 

C APPROPRIATE SIZE a CONTAINS NO SPECIAL SYMBOLS. IF FOR ANY REASON 

C THE STRING Is NOT CORRECT AN ERROR WILL BE FLAGGED AND THIS 

Z PROCEDURE WILL RETURN TO THE FILER PROMPT LINE 

PROCEDURE FINQDELIM(SIZE. MESSAGE : INTEGER; VAR STRUNG : STRNGU 

\/AR 

ERROR : BOOLEAN; 



C SCANS STRUNG FOR THE APPROPRIATE SPECIAL SYMBOL 

FUNCTION SCAN2CCH : CHAR) : BOOLEAN; 

BEGIN 

SCAN2 := SCAN(LOC,= CH, STRIINGC13) = 

END; 



C'$» 



♦ , ? , t»=»3 



LOC 



BEGIN C FINDDELIM D 

STRUNG := COPY(STR,l,LOC); Z 
ERROR := LOC > SIZE; Z 

DELETE(STR»iaOC) ; 
DELETE(STR«1,U ! 

IF (NOT ERROR) AND SCAN2( , $») AND 
EXIT(FINDDELIM)? C NO ERRORS 
CLEARLINE! 

IF NOT SYSCOM^.MISCINFO.SLOWTERM THEN 
WRITE(STRIING) ; 

IF SYSCOM^.CRTINFO. WIDTH < 80 THEN C 

WRITEANDCLEAR; 
IF ERROR THEN 



RETURNS CORRECT PORTION OF THE STRING 1 
TOO LONG TO BE A LEGAL ENTRY 1 



SCAN2CS 1 ) AND 
ENCOUNTERED 2 



SCAN2(»?») THEN 



LINE WILL NOT FIT IN 40 CHARS. 1 



WRITE( 



.TOO LONG <») 



MESSAGE OF 
; WRITE(t FILE 

WRITE{» 

WRITE( • 



NAME • ) ; 
SCAN STRING *) 
VOL NAME •) ; 



CASE 
1 
2 
3 

END; 

IF ERROR 
BEGIN 

IF MESSAGE = 3 THEN 
WRITE(VIDLENG) 



THEN 
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110 9 


1 


2S:2 


266 


1110 


1 


25:i 


292 


1111 


1 


25:0 


296 


1112 


1 


25:0 


308 


1113 


1 


25:0 


303 


1114 


1 


27:0 


3 


1115 


1 


27:0 





1116 


1 


27:1 





1117 


1 


27:0 


16 


1118 


1 


27:o 


23 


1119 


1 


24:o 





1120 


1 


24:o 





1121 


1 


24:i 





1122 


1 


24:2 


15 


1123 


1 


24:3 


15 


1124 


1 


24:3 


18 


1125 


1 


24!3 


27 


1126 


1 


24:4 


32 


1127 


1 


24:5 


37 


1128 


1 


24:4 


57 


1129 


1 


24:5 


59 


1130 


1 


24:3 


78 


1131 


1 


24:3 


91 


1132 


1 


24:3 


109 


1133 


1 


24:2 


112 


1134 


1 


24:2 


114 


1135 


1 


24:2 


114 


1136 


1 


24 :i 


114 


1137 


1 


24:1 


130 


1138 


1 


24:2 


136 


1139 


1 


24:i 


140 


1140 


1 


24:i 


157 


1141 


1 


24:i 


166 


1142 


1 


24:i 


174 


1143 


1 


24 :i 


174 


1144 


1 


24:i 


174 



^LSE 

WRITE(TIULEMG) ; 
rfRITEC ' - CHAR. MAX >» ) ; 

EN J 
ELSE 

WRITER- ILLEGAL FORMAT'); 
EXIT(CALLPROC) 
END C FINDDELIM J; 

C SCAN STR FOR SPECIAL SYMBOLS C '$• • • = • • '?• « • » • 3 2 

FUNCTION SCANKCH : CHAR) : INTEGER! 
3ESIN 

SCAN1 := SCANCLENGTH(STR), = CH tSTRC 1 3) ? 
ENo; 

BEGI:-J 

C NEED TO GET INPUT STRING FROM USER 2 
IF INSTRING = »» THEN 
BEGIN 

CLEARLINE; 
WRITE(MSG) ; 

IF FIRSTCALL AND FAST THEN 
IF FILLE THEN 

WRITE( ' WHAT FILE') 
ELSE 

WRITE{ ' WHAT VOL') ; 
WRITEf ? ')5 
READLN(INSTRING) ; 
EATSPACES(INSTRING) 
END! 

C COPY INPUT STRING INTO STR UP TO THE FIRST COMMA OR END OF LINE 1 
LOC := SCAN(LENGTHUNSTRING). = » ♦ » ♦ INSTRINGC1 1) J 
IF LOC > 35 THEN 

EXIT(CALLPROC) ? 
STR := C0PY(INSTRING»1«L0C) I 
DELETE {INSTRING* It LOC) ? 
OELETE(INSTRINGtltl) 5 

C PARSE VOLUME NAME OUT OF STR. CHECK TO SEE IF QUESTION IS TRUE 2 
QUESTION := QUESTION OR (SCANK'?') < LENGTH ( STR )) ; 
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i 24;i 


1S3 


1146 


i 2h:i 


195 


1147 


1 24:2 


211 


Ufa 


l 24:i 


214 


11^9 


i 24:2 


213 


1150 


1 24:3 


226 


1151 


1 24:4 


226 


1152 


1 24:4 


233 


1153 


1 24:3 


234 


1154 


i 24:1 


237 


1155 


i 24:i 


262 


1156 


l 24:i 


262 


1157 


l 24 :i 


262 


1158 


i 24:i 


269 


1159 


L 24:2 


278 


1160 


L 24:3 


278 


1161 


L 24:4 


294 


1162 


I 24; 3 


298 


1163 ; 


L 24:3 


304 


1164 1 


L 24:3 


320 


1165 ] 


L 24:3 


337 


1166 : 


L 24.'2 


366 


1167 I 


L 2412 


366 


1166 3 


2412 


366 


1169 1 


24 :i 


366 


1170 ] 


24:i 


373 


1171 1 


24:i 


380 


1172 1 


24:2 


389 


1173 1 


24:i 


396 


1174 1 


24:1 


405 


1175 1 


24:1 


405 


1176 1 


24:2 


405 


1177 1 


24.'3 


410 


1178 1 


2414 


410 


1179 1 


24:5 


416 


1180 1 


24:4 


422 


1181 1 


24:4 


425 


1182 1 


24:4 


430 


1183 1 


24:4 


436 


1184 1 


24:3 


439 


1185 1 


24:2 


441 



LOc := scafmk •: • ) ; 

IF (STR C12 = »«•) OR (LOC < LENGTH(STR)) THEN 

FlNDJELlM(VlDLENGf3 t \/OLMAN|E) 
ELSE 

IF STRCIH = •*• THEN 
BEGIN 

DELETE(STRtl.l); 
VOLNAME := •*♦ 
END! 
WHERETO := C0NCAT(V0LNAME, »: • ) ; 

C EXPAND THE •$• IF ONE EXISTS 1 
I := SCAN1('$») ; 
IF I < LENGTH(STR) THEN 
3EGIN 

IF LENGTH(STR)+LENGTH(SRCSTR)-1 > 35 THEN 

EXIT(CALLPROC); C ILLEGAL EXPANSION, TOO LONG 1 
OLO := STR; 

STRCOD := CHR(LENGTH(SRCSTR)+LENGTH(STR)-1); 
M0VELEFT(SRCSTRC1D,STRCI+13,LENGTH(SRCSTR) ) ? 

M0VELEFT(0LDCl+23»STRCI+l+LENGTH<SRCSTR>] f LENGTH(0L0)-I-l); 

END; 

C SCAN FOR WILDCARDS 1 

SRCSTR := STR; 

LOC := SCANK • = ») 5 

IF LOC = LENGTH<STR) THEN 

LOC := SCAN1( »?») ; 
IF LOC < LENGTH(STR) THEN 

C WILCARD SYSM80L IS PRESENT. PARSE REMAINING STRING ACCORDINGLY 1 
IF WILD THEN 
BEGIN 

IF NOT (FIRSTCALL OR WILDCARD) THEN 

MESSAGES(BADFORMtTRUE) ; 
WILDCARD := true; 

FINDQELIM(TIDLENG,2,FIRSTSTR) ! 
LOC := LENGTH(STR) J 

FINDDELIM(TIDLENG,2,SEC0NDSTR) 
END 
ELSE 
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1166 


1 
J. 


24:3 


443 


1187 


1 


24 :i 


447 


1136 


1 


24:i 


451 


1189 


1 


24:i 


4bl 


1190 


1 


24:2 


451 


1191 


1 


24:3 


451 


1192 


1 


24:3 


463 


1193 


1 


24:3 


463 


1194 


1 


24.*3 


463 


1195 


1 


24:3 


463 


1196 


1 


24:3 


463 


1197 


1 


24:4 


463 


1198 


1 


24.*5 


463 


1199 


1 


24:5 


494 


1200 


1 


24:6 


499 


1201 


1 


24:4 


505 


1202 


1 


2<*:3 


505 


1203 


1 


24:3 


510 


1204 


1 


24:2 


530 


1205 


1 


2<+:i 


532 


1206 


1 


24 :i 


536 


1207 


1 


24:i 


536 


1208 


1 


24:2 


536 


1209 


1 


2^:3 


536 


1210 


1 


24:3 


546 


1211 


1 


24:3 


549 


1212 


1 


24:3 


555 


1213 


1 


24:3 


555 


1214 


1 


24:3 


555 


1215 


1 


24:2 


561 


1218 


1 


24:i 


561 


1217 


1 


2452 


563 


1218 


1 


24:3 


579 


1219 


1 


24:2 


579 


1220 


1 


24:3 


584 


1221 


1 


24:3 


587 


1222 


1 


24:3 


587 


1223 


1 


24 :i 


567 


1224 


1 


24:2 


590 


1225 


1 


24:i 


602 


1226 


1 


24.'2 


606 



MESSAGESCJOWlLDiTRUE) C WILCARD OPERATION IS NOT ALLOWED 3 

ELS" 

C NO WILCARJS. REMAINING STRING IS A STANDARD FILENAME D 
3 EG IN 

IF (NOT FIRSTCALL) AND WILDCARD AND (DEFAULT = 0) THEN 

C USER USED A WILDCARD SYMBOL FOR THE SOURCE FILE BUT NOT THE 3 

C DESTINATION FILE. ONLY CASES THAT THIS IS ALLOWED IS WHEN 2 

I THt USER IS LISTING THE DIRECTORY (I.E., DEFAULT <> 0) OR 3 

C WHEN THE DESTINATION FILE IS AN UNBLKD-VOLUME 3 

3 EG IN 

SC ANlNpUT < CONC AT (V0LNAME2, •:»),[ 3, 0» NEITHER, FALSE)} 
IF LASTSTATE <> UN3LKDV0L THEN 

MESSAGES(BADFORM.TRUE) ! 
END; 
FINDDELIM(SHSTRLENG,1,FIRSTSTR) ; 
WHERETO := CONCAT(WHERETO,FIRSTSTR) 
END; 
IF NOT FIRSTCALL THEN 

C SET DESTUNIT & DESTVID TO THERE PROPER VALUES 1 
BEGIN 

SCAN INPUT ( WHERETO, C 3,0, WHERE ♦ TRUE) J 
DESTUNIT := GUNIT; 
DESTVID := GVID; 

C MAKE SURE THAT THE USER HASN»T REMOVED THE SOURCE DISK 3 
INSERTVOLUME(SOURCEUNIT,SOURCEVID,TRUE) ; 

END 

ELSE 

IF (INSTRING <> ••) AND (DEFAULT <= 0) THEN 

WHERE := DESTINATION 
ELSE 

WHERE := neither; 

C RESTORE THE DIRECTORY ETC. FOR THE SOURCE VOLUME 3 
IF WILDCARD THEN 

SCANINPUT(FR0MWHERE,C0KDIR 3 ,BLKDEXP, SOURCE, TRUE) 

ELSE 

SCANINPUT(FR0MWHERE,CHECK1,ERR0R1, SOURCE, TRUE) 5 
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1 
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1 


23:1 


19 
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1 


23:i 


34 
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37 


1235 


1 


23:i 


43 


1236 


1 


23:2 


48 


1237 


1 


23:i 


52 


1238 


1 


23:2 


66 


1239 


1 


23:i 


70 


1240 


1 


23:0 


84 


1241 


1 


23:0 


96 


1242 


1 
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96 


1243 


1 


23:o 


96 


1244 


1 


23!0 


96 


1244 


1 


23:0 


96 


1245 


1 


23:0 


96 


1246 


1 


23:0 


96 


1247 


1 


23:0 


96 


1248 


1 


23 :o 


96 


1249 


1 


23:o 


96 


1250 


1 


23:0 


96 


1251 


1 


23:o 


96 


1252 


1 


23:o 


96 


1253 


1 


28:0 


3 


1254 


1 


28:o 





1255 


1 


28:i 





1256 


1 


28:i 


3 


1257 


1 


28:i 


14 


1258 


1 


28:2 


24 


1259 


1 


28:o 


68 


1260 


1 


28:0 


86 


1261 


1 


2850 


86 


1262 


1 


28 :o 


86 


1263 


1 


29:d 


1 


1264 


1 


29:d 


1 


1265 


1 


29:d 


1 


1266 


1 


29:0 


41 



end; 

BEGIfsj z CHECKFILE 3 
INIT3L0BALS! 

srcstr := ••; 

PR0CEsSDATA(MSGl f TRUEtV0LNA«1El.STRINGltSTRING2iFR0MWHERE); 

sourceunit := gunit; 
sourcevio := gvid; 
if default > then 

exit(checkfile) \ 
if (instriwg = ♦•) and (default < 0) then 

exit(checkfile) ; 

PROCESSDATA (MSG2, FALSE. V0LNAME2,STRlNG3,STRIfMG4,T0WHERE); 

END; 



C$1 FILER. B.TEXT3 

C$1 FILER. C.TEXT3 

C COPYRIGHT (C) 1979 REGENTS OF THE UNIVERSITY OF CALIFORNIA. 3 

C PERMISSION TO C OPY OR DISTRIBUTE THIS SOFTWARE OR DOCUMEN- 1 

C TATION IN HARD OR SOFT COPY GRANTED ONLY BY WRITTEN LICENSE 3 

C OBTAINED FROM THE INSTITUTE FOR INFORMATION SYSTEMS. 3 



PROCEDURES FOR MOVING, MAKING AND CHANGING FILES 3 



C CHECKS TO SEE IF FILE IS ENDANGERED BY THE OPERATION TO BE PERFORMED 3 

FUNCTION FINDSAME(D00 : BOOLEAN ): BOOLEAN J 

BEGIN 

FINDSAME := TRUE; 

IF (LASTSTATE = OKFILE) AND (DOO OR (SOURCETlTLE <> GTID) OR 

(SOURCEVID <> GVID)) THEN 
FINDSAME := PURGElT(CONCAT(GVID»*:»,GTID).»REMOVE OLD*) 
END; 

C ALLOWS THE USER TO CHANGE THE NAME OF ANY FILE IN THE DIRECTORY 3 
C OR THE NAME OF ANY BLOCKED DEVICE 3 

PROCEDURE CHANGER; 
VAR 

gfib ; untyped; 
gfi3p : fibp; 
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1267 

126,3 

1269 

1270 

1271 

1272 

1273 

1274 

1275 

1276 

1277 

1278 

1279 

1280 

1281 

1282 

1283 

1284 

1285 

1286 

1287 

1288 

1289 

1290 

1291 

1292 

1293 

1294 

1295 

1296 

1297 

1298 

1299 

1300 

1301 

1302 

1303 

1304 

1305 

1306 

1307 



1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 



29; 
29; 
29; 
29; 



94 



29:2 

29:2 

2912 

29:2 

29:2 

29:3 

29:4 

29:4 

29:4 

29:5 

29:4 

29:4 

29:5 

29:6 

29:6 

29:6 

29:6 

29:6 

29:7 

29:8 

29:9 

29!9 

29:9 

29:8 

29:6 

29:6 

29:5 

29:3 

29:2 

29:3 

29:3 

29:3 

29:4 

29:5 

29:5 

29.*6 

29:6 



42 
'4 4 


12 
4-4 
52 
72 
72 
72 
72 
78 
106 
110 
137 
140 
159 
159 
169 
173 
181 
197 
204 
208 
208 
216 
228 
236 
236 
242 
244 
246 
248 
250 
264 
264 
264 
264 
278 
263 
289 



IORSlTiLOC 



INTEGER 



BEGIN C CHANGER 3 
REPEAT 

CHECKFILE( »CHAfjGE», 'CHANGE TO WHAT », , FILEBLKDEXP . TRUE , TRUE , 

COKFILE.OKDIR3) 5 
IF {(STRING1 <> »'} AND (STRINGS <> '•)) OR WILDCARD THEN 

C CHANGING A FILENAME 1 
BEGIN 

V0LNAME2 := VOLNAMEi; C DEST VOLNAME MUST BE THE SAME AS SOURCE 3 

TOWHERE := CONCATfVOLMAMEl*':*) ; 

IF NOT WILDCARD THEN 

TOWHERE := C0NCAT(T0WHERE»STRING3) ; C DEST FILENAME IS IN STRING3 3 

loc := o; 

WHILE SEARcHDIR(»CHANGE'»LOC«TRUE,TRUE) DO 
BEGIN 

RESET(GFIB,FROMWHERE)? C OPENS FILE TO BE CHANGED 3 
CHECKRSLT(I0RESULT){ 

GFIBP := GETPTR(GFIB)} C GETS THE POINTER TO THE FILES HEADER 3 
SCANINPUT < TOWHERE. CBADFILE,OKFILE3,FILEEXP, DESTINATION, TRUE); 
IF FINDSAME(FALSE) THEN 
WITH GFIBP* DO 
BEGIN 

FHEADER.DACCESS.YEAR := 100* C LET THE OP-SYSTEM KNOW 3 
PRINTMESS(FVIDtFHEADER.DTID.GTID); 

FHEADER.DTID := GTID; C CHANGE THE FILENAME 3 
END? 
CLOSE(GFIB); 
CHECKRSLT(IORESULT) 
END 
END 
ELSE 

IF LENGTH(STRINGI) + LENGTH ( STRING3 ) = THEN 

C CHANGING A VOLUME NAME 3 
BEGIN 

SCANINPUTt TOWHERE «CN0V0L.0KDIR 3. BLKDEXP, DESTINATION* TRUE) ; 

IF LASTSTATE = OKDIR THEN 

MESSAGES(VOLONLINEiTRUE) J C DON»T ALLOW TWO VOLS WITH SAME NAME 3 
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1 


29:s 


239 


1309 


1 


29:5 


239 
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1 


2915 
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1 


29:5 
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29:5 


313 
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29:5 


320 
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29:5 


330 
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2915 


334 


1316 
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29:5 


338 


1317 


1 


29:5 


342 


1318 


1 


29:5 


352 


1319 
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29,'6 


368 


1320 


1 


29:5 


375 
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1 


29:6 


384 


1322 


1 


29:5 


391 


1323 


1 


29:4 


398 


1324 


1 


29:3 


400 


1325 


1 


29:4 


402 


1326 


1 


29:i 


406 


1327 


1 


29!0 


411 


1328 


1 


29:0 


446 


1329 


1 


29:0 


446 


1330 


1 


3o:d 


1 


1331 


1 


3o:d 


1 


1332 


1 


3o:d 


1 


1333 


1 


3o:d 


7 


1334 


1 


3o:d 


9 


1335 


1 


30:0 
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1 


3o:i 
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1 


30:2 





1338 


1 


30:2 


26 


1339 


1 


30:2 


29 


1340 


1 


30:2 


32 


1341 


1 


30:2 


39 


1342 


1 


30:3 


58 


1343 


1 


30:4 


58 


1344 


1 


30:5 


62 
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1 


30:6 


62 


1346 


1 
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82 
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1 
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91 
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1 


3o:a 
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C ALLOCATE ROOM FOR THE DIRECTORY & READ IT IN 2 

NEW ( GDI R) i 

U;JlTREAQ(SOURCEUNIT.GDIR~.SlZEOF<DIRECTQRY> .DIRBLK) ; 
CHECKRSLT(IORESULT) ; 

GDIR A COD.DVID := GVID; C CHANGE THE VOLUME NAME 2 
UNITWR I TE:(S0URCEUNIT,GDIR A ,SI2E0F( DIRECTORY ),DIRBLK)5 

iorslt := ioresult; 
release(gdir) ; 
checkrslt(iorslt) ; 

UNITABLECSOURCEUNITD.UVID := GVID; C UPDATE THE UNITABLE 3 
IF (SYVID = SOURCEVID) AND ( SYSCOM^.SYSUNIT = SOURCEUNIT) THEN 

SYVID ;= GVID; C NAME OF ROOT DEVICE HAS BEEN CHANGED 2 
IF DKVID = SOURCEVID THEN 

DKVID := GVID; C PREFIXED VOLUME'S NAME WAS CHANGED 3 

PRINTMESS(SOURCEVlD,",GVID) C TELL USER YOU DID THE CHANGE 3 
END 
ELSE 

MESSAGES! ILLCHANGE.TRUE) C CAN»T CHANGE A VOLNAME TO A FILENAME 3 
UNTIL INSTRING = " 
END CCHANGER3 ; 

C ALLOWS THE USER TO REMOVE ANY SELECTED FILE FROM THE DIRECTORY 3 

PROCEDURE REMOVER; 

VAR 

DELETIONS : BITMAP? 
LINE,LOC : INTEGER' 

BEGIN C REMOVER 3 
REPEAT 

CHECKFILE( 'REMOVE » , • • , 1 , FILEEXP iTRUE tTRUE.COKFILE]) ; 

LINE := 0; C KEEPS TRACK OF WHAT LINE OF OUTPUT YOUR AT 1 

loc := o; 

FlLLCHAR(DELETlONS,SIZEOF(OELETIONS)iCHR(0)); C INIT'S BITMAP 3 
WHILE SEARCHDlR{'REMOVE'»LOCtFALSE,TRUE) DO C GET FILENAME 3 
BEGIN 

IF NOT QUESTION THEN 
BEGIN 

PRINTMESStGVlDtGDIR^CLOCD.DTlD. •REMOVED' ) ; 

IF SYSCOM^.CRTINFO. HEIGHT = LINE THEN C DON'T SCROLL OUTPUT 3 
BEGIN 

NSPACEWAIT(FALSE) 5 
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40 
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CLETAKSCKEEN; 
LTi\jE := 

END; 

line := line+1j 
end; 

DELETIONS. ENTRIES : = DELETIONS. ENTRIES + 1; C FILE TO BE REMOVED 3 
DELETIONS. DIKENTRY CLOC3 := TRUE C TOTAL » OF FILES TO BE REMOVED 3 

END; 

IF (FOUND IN CFILEFOUND.A30RTIT3) AND ( DELETIONS. ENTRIES > 0) THEN 
BEGIN 

CLEARLINE; 

WRITEC •UPDATE DIRECTORY ? •); C MAKE USER CONFIRM THE REMOVAL f 3 

IF NGETCHAR(TRUE) THEN 

ZAPENTRIES(DELETIONS.TRUE); C WILL REMOVE THE SELECTED FILES 3 
END; 
UNTIL INSTRING = " 
END CREMOVER3 ; 

C ALLOWS THE USER TO TRANSFER ANY FILE IN THE DIRECTORY TO ANOTHER DISK OR 3 
C TO ANOTHER FILE. WILL ALSO PERFORM COMPLETE OR PARTIAL BINARY TRANSFERS 3 

C OF One DISK TO ANOTHER 3 

PROCEDURE TRANSFER; 

VAR 

LAST3LK.L0C : INTEGER; 

C PERFORMS THE ACTUAL TRANSFER OF THE FILE FROM ONE LOCATION TO ANOTHER 3 

procedure movefile; 

VAR 

relblk,numblks,nblocks : integer; 

FlRsTCALLtSINGLEURlVE : BOOLEAN; 

GF13P : fibp; 

GFIB : UNTYPED; 

BEGIN 

RESET(GFIB.FROMWHERE) ! C OPEN SOURCE FILE 3 
CHECKRSLT(IORESULT) ; 

GF13P ."= GETPTR(GFIB) J C GETS A POINTER TO THE HEADER OF THE SOURCE FILE 3 

C BLOCK RELATIVE TO THE SOURCE FILE 3 



relblk := 0; 

FlRSTCALL := TRUE; 
REPEAT 

NUMBLKS := LASTBLK - RELBLK; 



C BLOCKS LEFT TO TRANSFER 3 



13*0 

1331 

1392 

13 33 

139'+ 

1395 

139b 

1397 

1398 

139 9 

1400 

1401 

1402 

1403 

1404 

1405 

1406 

1407 

1408 

1409 

1410 

1411 

1412 

1413 

1414 

1415 

1416 

1417 

1418 

1419 

1420 

1421 

1422 
1423 
1424 
1425 
1426 
1427 
1428 
1429 
1430 



1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 
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Is- NUKBLKS > GdUFBLKS THEN C GBUF3LKS = * OF B|_KS IN TRANSFER BUFFER 1 

NUMBLKS := GBUFBLKS; I UfMBLE TO FIT WHOLE FlCE IN TRANSFER BUFFER 
-j-iLOuKS := 3LOCKREAD<GFlBiG3UF'MJUMBLKSiRELBLK)i 
CHtCKRSLT(IORLSULT); C NSLOCKS = U OF BLOCKS ACTUALLY READ 3 

BEGIN 

FIRSTCALL := FALSE; 

SCANINPUT(TOWHERE,CNOVOL,BADOIR,BADFILE,UNBLKDVOL,OKDIR,OKFILED, 

tp firwrno • x .., ^ in , FILEVOLEXP,DESTlNATION,TRU£>; 

IF ((GVID2 <> ••) AMD (GVID2 C13 = •«•) AND (GUNIT = SOURCEUNIT) 

AND UNITA3LE CGUNIT3.UISBLKD ) OR (GUNIT = 0) THEN 

C DESTINATION DISK IS NOT ON-LINE AT THE MOMENT 3 
BEGIN 

CLEARSCREEN; 

IF GUNIT = THEN 

WRITELN(»PUT IN »»GVID,»:') 
ELSE 

WRITELNC 'INSERT DESTINATION DISK') 5 
NSPACEWAIT(TRUE) ; 

C MAKE SURE THAT THE USER PUT THE VOLUME ON-LINE 3 

SCANINPUT(TOWHERE,CBADFlLE.OKFlLEtBADDlR»OKDIR,UNBLKDVOL3. 
rfcin . FILEVOLEXP, DESTINATION, TRUE) 1 

ENu « 

IF GUNIT IN C1.23 THEN 

CLEARSCREEN; C DESTINATION IS THE CONSOLE: 3 
IF NOT FINDSAME(FALSE) THEN 

IF^BLicKs'^D^RBLK THEN D ° ESN ' T """ T0 RC "° VE ™ E DUPUCATE FILE 3 

Dr ^Tr^ 0L ^ E! C MAKE SURE THAT A DIS * ISN'T INDANGERED 3 
REWRITE(LFI3,T0WHERE); C OPEN DESTINATION FILE 3 
CHECKRSLT(IORESULT); 

C GET A POINTER To THE HEADER OF THE DESTINATION FILE 3 
LFIBP := GETPTR<LFI3H 

IF NOT LFISP^.FISBLKO AND GFIBP^.FISBLKD AND 

<GFIBP*.FHEADER.DFKIND = TEXTFILE) THEN 
BEGIN C DISK TO CHARACTER DEVICE DON'T TRANSFER HEADING 3 

nqlocks := nblocks-2; 
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^OVElEFT(GBUF a CF3LKSIZE + FSLKSIZE3»G3UF' % .NBLOCKS*F3LKSIZE) 
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en o; 
SINGLEDR1VE := ( LFI3P" . FVID <> GFIBP~ .FVID ) AND 

(LFIBP A .FUNIT = GFIBP A .FUNIT) 

END 
ELSE 

if singledrive then c allow user to insert destination disk 3 
i nsertvolumeilfibp^.funit.lfibp*. fvid* false) 5 
numblks := blockwrlte(lfistgbuf'\nblocks,relblk) ; 
checkrslt(ioresult); 
if nblocks <> numblks then 

messages(filefull.true) ; c wasn't able to write out all the blocks 3 
if singledrive and not eof(gfib) then 
c allow user to insert source disk 3 
insert volume (lfibp~.funit»gfibp*. fvid, false) ; 
relblk := relblk + numblks c increment relative block to the file 3 

UNTIL (RELBLK = LASTBLK) OR EOF(GFIB); 
WITH LFIBP A .GFIBP".FHEADER DO 

BEGIN C MAKE THE HEADERS TO THE TWO FILES THE SAME 3 
FHEADER.DLASTBYTE := DLASTBYTE* 
FHEADER.DFKIND : = DFKIND; 
FHEADER.DACCESS := DACCESS; 

IF (DACCESS. MONTH = 0) AND ( THEDATE. MONTH > 0) THEN 
FHEADER.DACCESS := THEDATE 
ENO? 
CLOSE(LFIB»LOCK)« 
CHECKRSLT(IORESULT); 
PRINTMESS(GFIBP~.FVID,GFI3P~.FHEADER.DTID* 

CONCAT(LFIBP A .FVID f • : • ,LFIBP A .FHEADER.DTID) ) ; 
CLOSE(GFIB) 5 
END? 

BEGIN C TRANSFER 3 
REPEAT 

CHECKFILEt •TRANSFER* .'TO WHERE' » 0,FILEVOLEXP»TRUE,TRUE t 

CBADDIR»OKFlLEfOKDlR»UNBLKDVOL3)5 
LASTBLK := MAXINT; C WILL BE SET TO THE # OF BLOCKS TO TRANSFER 3 

loc := o; 

IF (STRING1 = ••) AND NOT WILDCARD THEN 

3EGIN C DISK TO DISK BINARY TRANSFER 3 
IF LASTSTATE IN COKDIR * BADDIR3 THEN 



l^l i ll\t ,11 wo GCT3LOCKSCTRANSFER. f . bL 0CKS. ,.# OF BLOCKS TO TRANSFER •, 1 , LASTBLK ) ; 

147* 1 31C5 114 E: , D 

11+75 i 3i :a ii El _ SE; 

1477 I IV't ,\t ^ IL£ SEARCHOIKCTRANSFER'.LOC. TRUE, TRUE) DO 

* ' x ~> a . h- 1 o y MOVEFILE 

J"; J" ?J :1 13i UNTIL INSTRING = »•; 

talo J f 1: ° 155 END C TRANSFER 3; 

1^80 1 31:0 170 

1482 1 33'n 17 ? PPn^n WS / HE USER T ° CREATE FILE(S > 0N THE DISK 3 

1483 1 S|:g I Zr W MAKEFILE, 

i X 4fls J ^!:S x GFIB : untyped; 

J 23:d 4i gfibp : fibp; 

I486 1 33:D 42 

,111 ! 11''° ° BEGlN C MAKEFILE 3 

1488 l 33:i REPEAT 

1490 I lilt It i? E KE5KiE7?SSE; , ;i*i FlLEEXP ;' r ^ E « TR «E,i:BADFILE,OKFILE3> • 

1491 1 33:3 43 3 ^GIN C CHECK F0R AN EXI STING FILE WITH THIS NAME 3 

IMS 1 33-4 5I REWRITEtGFlB.FROMWHERE); C OPEN THE FILE 3 

1494 1 33-4 =7 CHECKRSLT(IORESULT); 

1495 1 33J4 65 SiTgFIBP^Do"* TJrrn m' J^l * P ° INTER T ° ™ E HEADER <> F THE FILE 3 

1496 1 33:5 69 J^5m 2 ?- 2ur5n2F2 T ° BE SURE ™ E FILE IS 0F THE CORRECT SIZE 3 
[HI \ \\" 33 CL0SE^ 8 ;L0^f ER - DLASTBLK - FHEADER - DFIRSTBLK ' 

1499 1 \\:l II CHECKRSLT(IORESULT); 

\lll \ 11'^ 93 CLEARLINE; 

1501 1 "iJ 143 en WRITELN(GVID..:.,GTID,. MADE*) 

]lll J IV 1 1£+3 UNTI «- ^STRING = " 

\lll * ^ : ° 1<+6 END MAKEFILE] ; 

1504 x 33:0 174 

1505 1 33:0 174 

"!? J 33:0 174 C$1 FILER. C.TEXT3 

150? 1 IV° 174 C$I FI ^*.D.TEXT3 

1508 1 \\'\ \11 C COPYRIGHT (C) 1979, REGENTS OF THE UNIVERSITY OF CALIFORNIA i 

1509 J 3^: JJJ ' ?^ S T T 10 o C ° PY ° R DIST RIBUTE THIS SOF^Ire OR SocK- ' 

1510 1 33*n 7 r TATI ° N IN HARD °* S0FT C0PY GRANTED ONLY B Y WRITTEN LICENSE 1 
15lS 1 33:'S 174 C STAINED FROM THE INSTITUTE FOR INFORMATION SYSTEMS. 3 
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JORKFILE MAINTANENCE PROCEDURES 



1 L'O 

3 



C ALLOCS THL USER TO SAVE HIS WORKFILE UNDER ANY DESIRED NAME 3 

FUNCTION SAVEW'JRK : BOOLEAN; 

TYPE 

FILESTRS = STRING £43; 
VAR 

gs : shortstring; 
ok : boolean; 

function saveit(whatfile : filestrg; which : fileklnd; 

var title : tid; var saved, gotit : boolean; msg : integer) : boolean; 

VAR 

GFiB : UNTYPED; 

gfibp : fibp; 
c changes the name of the workfile to the name desired by the user 3 

BEGIN C SAVEIT 3 
SAVED := TRUE? 
WITH USERINFO DO 
BEGIN 

RESET ( GFIB, CONCAT{ •♦SYSTEM.WRK. » , WHATFILE) ) J 
GFIBP := GETPTR(GFIB); 
WITH USERINFO, GFIBP%FHEADER DO 
IF GFIBP*. FISOPEN THEN 
BEGIN 

daccess.year := 100; 

title ;= concatiworktidt'.'iwhatfllemc change the workfile name 3 

dtid := title; c change the name of the file 3 

saveit := true; 

cl0se(gfib, normal) 

END 
ELSE 
BEGIN 

saveit := false; 

gotit := false; 

messages(msg»false) c couldn't find the workfile 3 

END 

Er.D 

END l SAVEIT 3; 
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c ch_:jc input string to be sent to the t(ransfer command 1 
procedure comcatit<str : filestrg; saved : boolean); 

bEGli 

IF i OT SAVED Ff-EN 

INSTrtlf-JG := cyNCAKlNSTRINGi »*SYSTEM. WRK. » «STRt • t • t 

GV^i^'.GTlD.'.'tSTRt •,• ) 

c ,\i q ; 

BEGIN r SAVEWORK J 
WITH USERIMFO 00 
BEGIN 

SAVErtORK := FALSE; C WILL BE SET TO TRUE IF SAVING TO A DIFFERENT DISK T 
uTlD := L-JORKTlt); 
3VID := workvid; 

3VID2 := W0RKV1D; 

IF TEXTSAVED AND CODESAVED THEN 
BEGIN 

WPITELN; 

IF GOTSYM OR GOTCODE THEN 

messages (wrksaved, true) ; 
messages ( nowrk t true ) ; 
end; 

OK := FALSE; 

IF WORKTIQ <> •• THEN I ALREADY HAVE A FILENAME T 
BEGIN 

clearline; 

write('save as • ♦ workvid , • : • , worktid, • ? »); 

ok := ngetchar(false) 

END; 
IF NOT OK THEN I NEED A NEW FILENAME 1 
CHECKFILECSAVE AS ','♦, 1 , FILEEXP, FALSE, TRUE, 

lNOVOL,BADDIR,BADFILE»OKDIR,OKFILED); 

IF LENGTH(GTID) > TIDLENG-5 THEN 

MESSAGES(ILLFILEV0L,TRUE)5 C FILENAME IS TOO LONG 1 
IF GVID2 <> SYVID THEN 

aEl3IN C SAVE TO ALTERNATE DISK 1 

INSTRING := »*; 

C0NCATIT( 'TEXT*, TEXTSAVED) ; 

CONCATIT{ 'CODE* , CODESAVED) ; 

DELETE(INSTRING,LENGTH(INSTRING),1)5 C REMOVE TRAILING COMMA 2 

SAVEWORK := TRUE; C WILL NEED TO ENTER TRANSFER AFTER LEAVING 3 



C ERROR NOTHING TO SAVE D 



C WORKFILE ALREADY SAVED 1 
C NO WORKFILE TO SAVE 3 
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C CHANGE TITLE OF WORFILE 3 

C CHANGE VOLUME I.D. OF WORFILE 3 



rxiTt SAVEWURK ) 

C i J J- 1 

,-.; .; r< k t i d := gtid; 

a'ORKvID : = GVlLi 

C L i" A K L I I'J E ; 

IF NOT TCXTSaVLU THEN 

BE^IN C TEXT FILE NEEDS TO BE SAVED 3 

IF S'WEIT< 'TEXT' , TEXTF ILE , SYMTIO , TEXTSAVED t GOTSYM t TEXTLOST ) THEN 
BE3IN 

IF COOLSAVED THEN L REMOVE OLD CODE EXISTING FILE 3 
IF PURGElT(CONCAT( '*' , wORK TIC »♦ .CODE ' ) »*' ) THEN 
WRITE COLD CODE REMOVED, '); 
WRITE ('TEXT FILE SAVED ') 
END; 
IF NOT CODtSAVED THEN 

WRITECS ♦) C WILL ALSO MEED TO SAVE NEW CODEFILE 3 

END; 
IF NOT CUDESAVLD THEN I SAVE CODE FILE 3 

IF SAVEIT{ ♦ CODE' .CODEFILE, CODE T ID, CODES A VED,GOTCODEfCODELOST) THEN 
wPITE( 'CODE FILE SAVED' ) 
END 
END [SAVEWCRK] ; 

C INFORMS THE USER IF A WORKFILE EXISTS AND IF SO 3 
I WHAT rjAME IT IS ASSOCIATED WITH 3 

PROCEDURE WHATWORK; 

BEGIN 

writcamdclear; 
with usekinfo do 

IF gOTSYM OR GOTCODE THEN 
3 c. G I N 

IF WORKTID = " THEN 
WRITE( 'NQT NAMED' ) 
ELSE 

wKITE( 'WORKFILE IS ' , WORKVID , ' : • , WORKTID ) ; 
IF NOT (TEXTSAVED AND CODESAVED) THEN 
wRITE( ' (NOT SAVED) • ) 

e;.o 

ELSE 

/JRITE( 'NO WQRKHLE' ) 

END C w i H t. T W R K 3 ; 
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C THERE'S A CODE OR TEXT FILE LOADED 3 
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C CLL'VTS Thl PRESENT WORKFILE. JSED IN GETWORK & NEWWORK 1 
PROCED jRL CLEA : U'0^ ; 

JEGl.j 

WITH JSERINFO DO 

30TSYM := FALSE; 
gqtcode := false; 



/iQRKTID 

symtid ; 
•cqoetid 

EN J 



;= • t 

- » t . 

:= » » 



COOESAVED) THEN 
WORKFILE HASN'T 

CURRENT WORKFILE 
THEN 



BEEN SAVED VERIFY ITS REMOVAL D 



END; 

C CLEARS THE PRESENT WORKFILE. IF A SYSTEM, WRK EXISTS WILL REMOVE IT 3 

PROCEDURE NEWWORK(GlVEBLURB: BOOLEAN); 

VAR 

GFI6 : FILE; 
BEGIN C NEWWORK 1 
WITH USER INFO DO 
BEGIN 

IF NOT (TEXTSAVED AND 
BEGIN t CURRENT 

clearline; 

write ('Throw away 

if not ngetchart false) 

EXIT(CALLPROC) i 
END 
ELSE 

IF GIVEBLURB THEN 

WRITELN; C WASN'T CALLED FROM GETWORK 1 

C REMOVE ALL WORKFILES 3 

IF PURGEIT('*SYSTEM. WRK. TEXT', ") THEN! 

IF PURGEIT('*SYSTEM.WRK.CODE'»") THEN! 

IF PJPGEIT( »*SYSTEM.LST.TEXT'» " ) THEN; 

C CHECK FOR A .BACK FILE IN CASE USER HAS A LARGE FILE EDITOR 3 
IF PURGEIT(COfJCAT(WOR,KTID»'. BACK'), 'REMOVE') THEN; 

TEXTSAVED := TRUE; 
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C0DE3AVE" I-- TKL'Li 
If SIVEDLJR5 THEN 

WITH uSERIhFO DO C INFORM THE USER OF THE STATUS OF THE WORKFILE 1 

tiEGXN 

clearlinl; 

WRITE( »*0RKFI.LE CLEANED' )? 
CLEAR/jQRK; 

END 
EN; 
END C NEWWORK D; 

C ALLOwS THE USER TO LOAD A NEW FILE NAME INTO HIS WORKFILE 1 

PROCEDURE GETWORK; 

TYPE 

SHORT = STRINGC 53 i 
VAR 

gone, ok : boolean; 
x : integer; 

L CHECKS TO SEE WHETHER OR MOT THE REQUESTED FILE TO BE LOADED EXISTS 1 
FUNCTION CHECKIT(SUFFlX,MESS:SHORT; var title:tid; VAR volid:vid) : BOOLEAN; 

BEGIN 

WITH USERINFO QO 

BEGIN 

CHtCKIT := FALSE; „.,., 

SCANINPUT (CONCAKWORKVlDf'I^iWORKTIDi SUFFIX ),COKFILEDiO» NEITHER. TRUE )t 

IF LASTSTATE = OKFILE THEN 

BEGIN C THE REQUESTED FILE HAS BEEN FOUND 3 
CHECKIT := TRUE; 
DONE := true; 

title := concat(worktid, suffix) ; 
volid : = workvid; 
if gotsyh then 

WRITERS •); 
WRITE (MESS) 

END 
END 

end; 



BEGIN C GETWORK 1 
NEWWORK ( FALSE) ; 



C CLEAR EXISTING WORKFILE 3 
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1718 

1713 

172 J 
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j.722 

1723 

1724 

1725 

1726 

1727 
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1729 
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1731 
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1735 
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1737 
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1739 

1710 

1741 
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1743 

1744 

1745 

1746 

1747 
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1748 
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1 

i 
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1 

1 

1 
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1 

1 

1 

1 

1 

1 

1 
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1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 
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4j:i 

40 :i 
40:2 

40:3 

4i):3 

411:3 

40.-3 
4C:3 
4013 

40:3 

40:4 
4C.*4 
4015 
4Q!6 
40:4 
40:5 
40:6 

4o:& 

40:5 
40:4 
40:3 

40:3 

40:4 

40:5 

40:5 

40:4 
40:3 
40:2 
<+o:o 



40 

40; 

40; 

40; 

4o; 

40: 

40: 

40; 

40; 

40! 

40: 
40: 



2d 

2b 

.-2 b 

26 
55 
42 
49 
56 
59 
59 
63 
70 
121 
131 
151 
151 
180 
202 
209 
209 
215 
225 
225 
227 
240 
240 
261 
261 
276 
276 
276 
276 
276 
276 
276 
276 
276 
276 
276 
276 



CHCCKFILEM • GET • , t t , 1 , f i L E£;xp , FALSE , TRUE , C 8ADFILE , OKFILE3 ) ; 

^ITH JSER INFO JO 

dEGl.M 

CLEARWORK; C CLEARWORK HASN'T CLEARED UORKFILE YET IN CASE 

WOrkVIO := GVlDi 



OF NUL INPUT 3 



I CAN A •.TEXT* OR '.CODE' SUFFIX BE ADDED 1 



OR 
OR 



• .CODE' SUFFIX MAY ALREADY EXIST 3 
<C0PY(W0RKTID»X-4,5)='.C0DE') THEN 
♦.TEXT' OR '.CODE' SUFFIX 2 
(WORKTID <> ••) THEN 
2 

,SYMTID,SYMVID) ; 

♦♦CODETIDiCODEVID) 



wo^ktig := gtio; 
x := length(worktid) ; 
ok := x <= tidl.eng-5! 
CLeaRLine; 

REPEAT 

done := not ok; 

IF DONE AND (X > o) THEN C '.TEXT* 

IF (C0PY(W0RKTID»X-4.5)=«,TEXT«) 

DELETE(W0RKTID»X - 4,5); C REMOVE 

IF UENGTH(WORKTIO) <= TIDLENG-5) AND 

BtGIN C SEE IF FILE IS IN DIRECTORY 

GOTSYM ;= CHECKIT< '.TEXT', 'TEXT » 

gotcooe := checkitccode'^code 
end; 

OK := FALSE 
UNTIL DONE; 
IF NOT (GOTSYM OR 
BEGIN C WASN'T 
CLEARWORK; 
WRITECNO ») 
END; 
WRITE( 'FILE LOADED') 
END 

end cgetwork: ; 



C*I FILER. D. TEXTD 

C$1 FILER. E.TEXTIl 

C COPYRIGHT (C) 1979, REGENTS OF THE UNIVERSITY OF CALIFORNIA. 

C PERMISSION TO COPY OR DISTRIBUTE THIS SOFTWARE OR DOCUMEN- 

C TATION IN HARD OK SOFT COPY GRANTED ONLY BY WRITTEN LICENSE 

C OBTAINED FROM THE INSTITUTE FOR INFORMATION SYSTEMS, 



GOTCODE) THEN 
ABLE TO FIND THE 



FILE 2 



2 
2 
2 

2 



c DIRECTORY RELATED ROUTINES -• 

C ALLOWS THE USER TO SET THE DATE IN THE DIRECTORY 1 



105 



1757 

175d 

1755 

176Q 

1761 

1762 

1763 

1764 

1765 

1766 

1767 

1768 

1769 

177Q 

1771 

1772 

1773 

1774 

1775 

1776 

1777 

1778 

1779 

1780 

1781 

1782 

1783 

1784 

1785 

1786 

1787 

1788 

1789 

1790 

1791 

1792 

1793 

179<+ 

1795 

1796 

1797 



1 
1 

1 

1 

i 
1 
1 
1 

1 
X 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

I 

1 

1 



42:j 
*2:j 
42:d 
42: j 

42: o 
42 :o 
42:o 
<+3:q 
43:o 
43:i 
«*3:i 
■+3:o 



43 
43 
43 
44 
44:D 

44:d 
44:0 
44:1 
44:1 
44:i 

44:2 
44!3 

44:1 
44:0 
44:0 
42:0 
42:1 
42:2 

42:3 
42:3 

42:4 
42:3 

42:3 
42:3 
42:3 
42:4 
42:3 
42:3 
42.'4 



1 

1 

J. 

1 
1 

ci. 

1 





21 

29 

42 

42 

42 

3 

4 

4 





4 

20 

31 

45 

68 

78 

96 









53 

63 

158 

179 

197 

202 

209 

216 

218 

227 



PRUNED JI<E .JATESET; 
CONST 

DASH = •-» ; 
VAR 

num : integer; 
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C ONLY uELIMMITER ALLOWED TO SEPARATE FIELDS IN THE DATE 3 



C DELETES INPUT STRING UP TO THE NEXT FIELD DELIMITTER 3 

PROCEDURE ZAPIT; 

BEGIN 

QEleTE(INSTRING»1»SCAN(LENGTH(INSTRING) ♦=DASH.INSTRINGC13)) ; 

QELETE(INSTRINGtltl) 

end; 

c translates number in character representalon into integer representation 3 
c and checks to see if it is in the allowable range 3 

function getnumber(max *. integer) .* boolean; 

VAR 

XfSTOP : INTEGER' 
BEGIN 

num := o; 

STOP := SCAN(LENSTH(INSTRIIMG)t=DASHtINSTRlNGCl3)l 
FOR X := 1 TO STOP DO 

IF INSTRINGCX3 IN DIGITS THEN 

NUM := NUM*10+ORD(INSTRINGCX:)-ORD(»0»)5 

getnumber := <num > o> and <num <= max) 

end; 

begin cdatesetj 
with thedate do 

BEGIN 

WRITELN( 'DATE SET: <1. . 31>-<JAN. ,DEC>-<00. .99>» M 

IF MONTH <> THEN C WRITE OUT PRESENT DATE IF IT IS VALID 3 

WRITELtsM *TQDAY IS • ,DAY t DASH»COPY< M0NTHSTR,M0NTH*3+1 .3) ,DASH» YEAR ) 5 
WRITEC 'NEW DATE ? •) 5 
READLN(INSTRING) ; 
EATSPACES(INSTRING) 5 
IF GETNUMBER(31) THEN 

DAY := NUM; C A NEW DAY WAS FOUND 3 
ZAPIT; C DELETE INPUT STRING UP TO THE NEXT DELIMMITER 3 
IF INSTRINGCGJ > CHR(2) THEN 

BEGIN 
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42:6 


298 
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320 


160o 
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42:4 


325 
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42:3 


334 
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42:3 


336 
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343 
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350 
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42:3 


333 
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42:4 


395 
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42:5 


395 
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406 
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411 
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503 
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45:0 
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312 
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51 
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g'vio co: := chr<3) ; 

NOVELEFM INSTRlNGC13.GVIDC13t3) ! 
FOR ,'<lUM := 2 TO 3 00 

IF (GVID CNUM3 >= »A») AND (GVIO CNUMD <= »ZM THEN 

GVIO LNUA2 := CHR( ORD(GVID CNUMD) - ORD('A') + ORD(»A»))i 
FOR NUM := 1 TO 12 DO 
IF C0PY(M0NTHSTRtNUM*3+li3> = GVID THEN 

MONTH := NUM C A me^ VALID MONTH HAS BEEN GIVEN 2 

end; 

ZAPIT; C DELETE INPUT STRING UP TO THE NEXT DELIMMITER 2 
IF GET,MUMBER{99) THEN 

YEAR := NUMi C A VALID YEAR HAS BEEN GIVEN 2 
SCANINPUT(CONCAT{SYVID.»:» >, COKDIR 2, , NEITHER ,TRUE ) ; 
IF (LASTSTATE = OKDIR) AND (GUNIT = SYSCOM^.SYSUNIT ) THEN 

BEGIN C THE ROOT VOLUME IS ON-LINE, WRITE THE DATE OUT TO ITS DIR. 2 
3DIR A C0:.DLASTBOOT := THEDATE; 
WRITEDIR(GUNIT»GDIR) ; 
END! 

WRITE(»THE DATE Is ' »DAY,DASH, COPY (M0NTHSTR,M0NTH*3+1 ,3) ,DASH« YEAR) 

END 
END C DATESET 1 i 

C ALLOWS THE USER TO SEE WHAT & WHERE HIS/HER FILES ARE IN THE DIRECTORY 1 

PROCEDURE LISTDIR(DETAIL: BOOLEAN); 

VAR 

NOFlLEStALTFILE : BOOLEAN; 

OUT : TEXT; 

LI STEDtLOC, LINE, LARGEST, FREE3LKS.USEDAREA,USEDBLKS: INTEGER! 

C KEEPS TRACK OF WHAT LINE OF OUTPUT WE'RE AT SO WE DON»T SCROLL LISTSING 1 

PROCEDURE WRITELINE; 

BEGIN 

IF (LINE = SYSCOM^.CRTINFO. HEIGHT) OR (LINE = 0) THEN 

BEGIN C WRITE OUT VOLUME NAME AT TOP OF EACH PAGE OF OUTPUT 2 
HOMECURSOR; 
CLEARLINE; 
IF NOT ((LINE = 0) OR QUESTION) THEN 

NSPACEWAIT(FALSE); C LET USER LOOK AT WHATS ON THE SCREEN 2 
IF (NOT UNlTABLECDESTUNin.UISBLKD) OR QUESTION THEN 

CLEARSCREENi C LISTING TO CONSOLE 2 
WRITELN(OUT) 5 
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.VrtlTECUdT.SOURCtlVI'J, • : • ) 5 * 

lIiMl := 2; 

iF ALTFILE THEM 

line := syscom^.crtinfo. height; c list the heading only once 1 

~_ \ 3 ; 

wRlTELN(OUT) ! 
LINE := LINE + 1 
END CWRITELINED ; 

C WRITES OUT UNUSED AREAS OM THE DISK 1 
PROCEDURE FREECHECK(FlRSTOPEN,NEXTUSED: INTEGER); 
VAR 

freearea: integek; 

BEGIN 

FREEAREA := NExTUSED-FlRSTOPEN ; C FINDS SPACE BETWEEN LAST & NEXT FILE 1 
IF FREEAREA > LARGEST THEN 

LARGEST := FREEAREA; C IS THIS THE BIGGEST SPACE ON THE DISK 1 

FREE3LKS := FREEBLKS+FREEAREA ; C RUNNING TOTAL OF FREE BLOCKS 3 
IF (FREEAREA > 0) AND DETAIL THEN C EXTENDED LISTING 3 
BEGIN 

WRITE(OUT,«< UNUSED >♦, FREEAREA: 10 .»•: 10 ) ; 
IF FAST THEN 

WRITE ( OUT* FIRST0PEN:6) 
ELSE 

write(OutiFIRstopen:5) ; 

writeline 

END 
END CFREECHECKD ; 

BEGIN CLISTDIRH 

CHECKFILEJ »DIR LISTING OF •♦»♦, -1 , FILEBLKDEXP, TRUE i FALSE tCOKDlRtOKFlLED ) ; 
ALTFiLE := TOWHERE <> • M C ARE WE LISTING TO CONSOLE: OR NOT ? 1 

IF A L TFILE THEN 
BEGIN 

SCANINPUTt TOWHERE, CBAOFILE»OKFILEtUNBLKDVOL 3, FlLEUNBLKDEXPt DESTINATION 

iTRUE) ; 
SC AN I NPUT < FROMWHERE tCOKDIRtOKFILE 3 i FILEBLKDEXP* SOURCE* TRUE) 
END 
ELSE 

TOWHERE := '#2:'; C WE ARE LISTING TO THE CONSOLE: 3 
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REWRlTE(OUTtTOhlHERL) ; 
CHECKRSLT(IOHESULT) ! 
LISTED := o; 
LOC := 0; 
LINE := 0; 
LARGEST := o; 
FREE-3LKS := 0; 

usedarea := os 



l CHANGE OUTPUT TO APPROPRIATE DEVICE 
C TOTAL U OF FILES LISTED 



C OUTPUT LINE tt TO AVOID SCROLLING OF LISTING 3 

C LARGEST FREE AREA ON THE DISK 3 

C TOTAL n OF FREE BLOCKS ON THE DISK 3 

C SIZE OF FILE LISTED 3 



USED3LKS := GDIR-C0D.DLAST8LK; C TOTAL # OF BLOCKS BEING USED 
IF STRING1 = •• THEN 

BEGIN C IN CASE OF EMPTY DIR THE U OF UNUSED BLOCKS WILL BE DISPLAYED 3 
NOFIl.ES := NOT WILDCARD AND (GDIR* C 3.DNUMFILES = 0); 
WILDCARD := TRUE; 
END; 
IF WILDCARD THEN 

WRITELINE C CORRECTION FOR GOOD LOOKING OUTPUT 3 
ELSE 

IF L No? NOFILES°?hEN RTINF ° ,HE:IGHT+1J C SINGLE FILE RE9 ' °° N,T WRITE HEADING 3 

WHILE SEARCHDlRt 'LIST'. LOC, FALSE. FALSE) DO C GET FILE TO BE LISTED 3 

BEGIN 

IF UNITABLECDESTUNIT3.UISBLKD AND (NOT QUESTION) THEN 

C WRITING DIRECTORY OUT TO A BLOCKED DEVICE 3 
IF LISTED s THEN C FIRST CALL TO PROCEDURE 3 
BEGIN 

WRITEANDCLEAR; 
WRITE( 'WRITING') 
END 
ELSE 

WRITEC.' ) 
ELSE 

CLEARLINE; 
LISTED := LISTED + i; 
WITH GDIR*CLOC3 DO 
BEGIN 

FREECHECK(GDIR"CLOC-i:.DLASTBLK,DFIRSTBLK);C CHECK FOR FREE BLOCKS 3 
USEDAREA := DLASTBLK-DFIRSTBLK ; C AREA USED 3 

USEDBLKS := USEDBLKS+USEDAREA; C RUNNING TOTAL OF USED BLOCKS 3 
WRITE ( OUT »DTID.":TIDLENG-LENGTH(DTID)+1, USEDAREA: 4, DACCESS. DAY: 3 
.'-»,COPY(MONTHSTR.DACCESS.MONTH*3+l,3),'-',DACCESS.YEAR:2)5 
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If DETAIL THEN C EXTENDED LISTING 1 

IF FAST THEf," 

a i RITE(0UT,0FIRST3LK:6,DLAST3YTE:6» ' ' :2« 

C OPY ( TYPES TRiORD(DFKIND)*4+ 1»4) , 'FILE 1 ) 
ELSE 

WRirr{0UT,DFlRST3LK:5i « » , COPY ( TYPESTR » ORD ( DFKINO ) *4+l , 4 

aRITELIiME 

END 

END; 
IF (POUND IN CFILEFOUND.A30RTIT3) OR NOFILES THEN 

3 E b 1 N 

IF WILDCARD THEN 
3EGIN. 

FREECHECK{GDIR"'CLOC3.0LASTBLK,GDIR A :OD.DEOVBLK) 5 
WRITECOUT.LlSTEDtV^GDIR^CO^.DNUMFILESt* FILES' ) ! 
IF FAST THEN 

^RITE(OUT»'<LlSTED/lN-DIR>t '.USEDBLKS*' BLOCKS USED')! 
WRITE(OUT,», SFREESLKS,' UNUSED* »•• '♦LARGEST,* INLARGEST')! 
IF ALTFILE THEN 
*IRITELN(OUT) 

end; 

checkrslt(ioresult) ; 
clQSE(out.lock) ; 
checkrslt(Ioresult) ; 

END 
END CLISTDIRD 5 

C LISTS THE VOLUMES THAT ARE ON-LINE 3 

PROCEDURE LISTn/OLS; 

BEGIN 

uJRITu L N; 

writeln( 'vols on-line: 1 ); 

gjnlt := v0lsearch(gvid,true,gdir) ; c update unitable d 

for gunit := i to maxunit do 

WITH JNITABLECGUNITD DO 
IF IjVID <> " THEN C VOLUME IS ON-LINE 3 
3EGIN 

WRITE(GUNIT:3) ; 
IF UISBLKD THEN 

WRITEC ft ') C BLOCKED OEVICE U 
ELSE 
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1 


4316 


101 


136 3 


i 


•+a:5 


111 


1964 


i 


46:4 


133 


19o5 


1 


4b: 1 


140 


i966 


I 


4-8:1 


138 


1967 


1 


43:0 


236 


1963 


i 


43:o 


250 


1969 


X 


48:o 


250 


1970 


1 


49:0 


1 


1971 


1 


49 :o 


1 


1972 


1 


<+9:o 


1 


1973 


1 


<+9:d 


14 


1974 


1 


"+9:o 





1975 


1 


t9:i 





1976 


1 


<+9:i 


7 


1977 


1 


49:i 


10 


1978 


1 


49:i 


39 


1979 


1 


49:i 


41 


1980 


1 


49:i 


67 


1981 


1 


49:2 


74 


1982 


1 

J. 


49:1 


77 


1983 


1 


49:1 


134 


1984 


1 


49:1 


139 


1985 


1 


49:2 


139 


1986 


1 


49:2 


164 


1987 


1 


49:2 


182 


1988 


1 


49:2 


187 


1989 


1 


49:. 5 


209 


1990 


1 


49:2 


242 


1991 


1 


49:2 


256 


1992 


1 


49:1 


287 


1993 


1 


49:1 


294 


1994 


1 


49:2 


294 


1995 


1 


49:3 


294 


1996 


1 


49:3 


300 


1997 


1 


49:3 


306 


1993 


1 


49:3 


313 


1999 


1 


49:3 


319 


2000 


1 


49.*3 


328 


2001 


1 


49:3 


332 


2002 


1 


49:2 


359 



white ( ' • :3> ; : unlocked device ] 

WRITELNtUViO, » : • ) 

WRIT,:lN( 'ROOT VOL IS - 'iSYVIQ,':'); C BOOTED VOLUME 1 
WFUTelN< 'PREFIX jS - ».DKVID.»:») Z PREFIXED VOLUME 3 

C CREATES AN E^PTY DIRECTORY ON A DISK ] 

PROCEDURE ZEROVOLJME; 

VAR 

lde: direntry; 



BEGIN C ZEROVOLUME 3 

FlLLCHAR(LDEiSlZEOF(LDE) ,CH 
L0E.DLAST3LK := DlRLASTBLKi 
CHECKFILECZERO QIR OF',", 
RISKVOLUME; C DOES THE 
WRITE( 'DUPLICATE DIR ? •); 
IF NSETCHAR(TRUE) THEN 

LDE.DLASTBLK := DUPDIRLASTBLK ; 
GETBL0CK3CARE THERE*, 'BLKS ON THE 

REPEAT 

WRITECNEW VOL NAME ? '); 

READLN(INSTRING) « 

EATSPACES(INSTRING) ; 

IF (INSTRING CLENGTH(INSTRING)3 
INSTRING := CONCATdNSTRING 

SCAf\|INPUT( INSTRING ♦CNOVOL 

WRlTE(GVIDi»: CORRECT ? •); 
UNTIL MGETCHAR(TRUE) ; 
WITH lOE DO 
BEGIN 

dfkind := untypedfile; c 
dvio := gvid; l 
dlastboot := thedate; c 
insert volume (sourceun i t,s 
unitwrite(s0urceunit.lde. 
checkrslt(ioresult) ; 

WRlTE(OVIO,': ZEROED') 
END 



R(0) ) ; 

C LEAVE ROOM FOR DIRECTORY AND BOOTSTRAP 
1. BLKDEXP, FALSE, FALSE, COKDIR,BADDIR 3); 
DISK ALREADY HAVE A DIRECTORY ON IT ? 3 

C DOES THE USER WANT A BACKUP DIRECTORY ? 



DISKS •# OF BLOCKS ON THE DISK' 
LDE.DLASTBLK, LDE. DEOVBLK) ; 



i • 



<> 

•) 



» ? t 



) AND (INSTRING <> • • ) THEN 



•OKDIR 3, BLKDEXP, NEITHER, TRUE) 



DIRECTORIES MUST BE OF THIS TYPE 

ENTERS NAME OF DIRECTORY 

USED TO SET THE SYSTEM DATE UPON BOOTING 
3URCEVID,TRUE>; C DON'T KILL THE WRONG DISK 
SIZEOF(LDE),DIRBLK); 
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2003 1 49 :0 3a ;> CNO [ Z"-<0 V JLUME D ; XX 

2004 1 49:0 374 

2905 i 4910 i74 L FILE MAIMTANENCE PROCEDURES 1 

200a I 49: j 37'+ 

2G07 1 4.3 :0 374 C iNFD^lS THE USEH> OF FILES ENDANGERED 3Y BAD BLOCKS D 

2008 i 50:0 1 PROCEDURE PRINTFIuFSJ 

2009 1 50 !Q 1 VAR 

2010 i 53 :d i i : integer; 

2011 i do:o a begin 

2012 1 5011 IF DIRMAP. ENTRIES > THEN 

2013 1 50:2 9 BEGIN C THERE ARE FILES ENDANGERED BY BAD BLOCKS 1 

2014 1 50:3 9 WRlTELN(»FlLE<S) ENDANGERED: 1 ); 

2015 1 50:3 44 FOR I 1= TO MAXDIR DO 

2016 1 50:4 55 IF DIRMAP.DIRENTRY C I 3 THEN 

2017 1 50:5 64 WITH GDIFT CI 3 DO 

2018 1 50:6 70 BEGIN 

2019 1 50:7 70 IF I = THEN 

2020 1 50:8 75 WRITE ( 'DIRECTORY • i •»: 7 ) C THERE'S A BAD BLK IN THE DIRECTORY 3 

2021 1 50:7 104 ELSE 

2022 1 50:8 106 WRlTE(DTIDt":i6-LENGTH(DTlD)) J C WRITE OUT THE FILES NAME 3 

2023 1 50:7 132 WRITELN (DFIRSTBLK:6 ,DLASTBLK:6 ) 

2024 1 50.*6 156 END 

2025 1 50 : 2 156 END 

2026 1 5010 163 END; 

2027 1 50:0 180 

2028 1 50:0 180 C DETERMINES WHAT FILE A BLOCK IS IN OR BETWEEN 3 

2029 1 51ID 1 PROCEDURE WHICHFILE < VAR BADBLK : INTEGER ; MARK I BOOLEAN); 

2030 1 5i:D 3 VAR 

2031 1 5l:D 3 X : INTEGER? 

2032 1 51:0 BEGIN 

2033 1 5i:i IF GDIR <> NIL THEN 

2034 1 51:2 5 BEGIN 

2035 1 51:3 5 FOR X := TO GDIR* C 3.QNUMFILES DO 

2036 1 51:4 21 IF GDIR" I X 3.DLASTBLK > BADBLK THEN 

2037 1 51:5 31 BEGIN C THE BLOCK MUST BE IN THIS FILE IF ANY AT ALL 3 

2038 1 51:6 31 IF NOT MARK THEN 

2039 1 51:7 35 3ADBLK := X C FOR K(RUNCH THIS IS ALL WE WANT TO KNOW 3 

2040 1 5156 36 ELSE 

2041 1 51:7 40 IF GDI*" C X 3. DFIRSTBLK <= BADBLK THEN 

2042 1 51:8 50 BEGIN C THE BLOCK IS IN THIS FILE MARK IT <S SUCH 3 

2043 1 51:9 50 DlRMAP .ENTRIES := DIRMAP. ENTRIES + 1; 
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5i:5 
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113 
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113 


2066 
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52:3 


126 


2067 
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52:4 


132 


2068 
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52:5 


132 


2069 
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140 


2070 
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52:5 


146 
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52:4 


195 
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52:2 


195 
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52:1 


205 
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242 
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242 
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DIKMAP.DIRENTRY CXD := TRUE 

END i 
EXirU'HlCHFILE) 
END; 
IF NOT MARK THEN 

BADBLK := GDIR- CO 3.DNUMFILES + 1 C WELL NEED THIS FOR K(RUNCH D 

END 
ENJi 

C SCANS THE BLOCKS ON a DISK FOR READ ERRORS 3 

PROCEDURE BAD3LOCKS5 

VAR 

A : ABLOCK; 

BLKiTOTALt NBLOCKS : INTEGER; 

BEGIN C BADBLOCKS ] 

CHECKFILECBAD 3L0CK SCAN OF' ,", 1 ,BLKDEXP, FALSE, FALSE, C0KDIR,BADDIR3> ; 
GETB u0 CKS('SCAN FOR ', 'BLOCKS' , 'SCAN FOR HOW MANY BLOCKS' , 1 ,NBLOCKS); 
I OT"L • •* 5 

FOR 3LK := TO NBLOCKS-1 DO 
BEGIN 

UNITREAD(GUNIT»A,FBLKSIZE,BLK) 5 
IF IORESULT <> THEN 

BEGIN # _ C AN ERROR WAS FOUND IN READING THE BLOCK 3 

WHICHFILE(BLK,TRUE)J C WAS THE BAD BLOCK IN A FILE 7 3 

WRITELN( 'BLOCK »»BLK,' IS BAD') 

END 
ENQ; 

SpT I ^ 1 ir!:T l < I2 TAL,, BAD BL0CKS,,! C PRIN T OUT THE FILES WITH BAD BLKS IN THEM 3 

END CBADBLOCKS3 i 

C COMPARES SUCCESSIVE READS & WRITES FOR EQUALITY. IF THEY ARE EQUIVELENT 3 

r 2^ UR n S ™ AT ™ E 8L0CK IS °' K - OTHERWISE DECLARES THE BLOCK AS BEING 3 
C BAD AND ALLOWS THE USER TO MARK THE AFFECTED BLOCKS AS SUCH T 

PROCEDURE XBLOCKS; 
VAR 

newdir : ^integer; 

bad : array c0..halfmaxdir3 of record 
first, last : integer 
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3LK.LASTiL0CKiL0C»FIRSTBLKiLAST3LK 

ldl : dikentry; 

A i 3 : ABLCCK; 



1 JL 



INTEGER; 



, "tlfBLKDEXPiFALSEtFALSE.COKDIR.BADDlRa); 



BEGIN r X3L3CKS 1 

CHECKFlLEt •EXAMINE BLOCKS ON' 

CLEArlINE! 

WRITE ( 'BLOCK-RANGE ? •); 

READ(FIRSTBLK) ; 

IF EOLN THEM 

LAST3LK := FIRSTBLK 
ELSE 

BEGIN 

readilast3lk) ; 
if not eoln then 

writeln; 
lastblk := abs(lastblk) 

END; 
IF GDIR <> NIL THEN 

IF LASTBLK >= GDIR'* C03.DEOVBLK THEN 

LASTBLK := GDIR* C D.DE0V6LK-1 5 C DON'T WANT TO SEEK PAST END OF DISK 1 
IF (FIRSTBLK < 0) OR (FIRST3LK > LASTBLK) THEN 

EXIT(XBLOCKS) ; c INVALID BLOCK RANGE i 

clearscreenj 

WRITELN; 

FOR 3LK := FIRSTBLK TO LASTBLK DO 



2125 



53:2 



279 



WHicHFILE(BLK,TRUE) ; 
IF DIRMAP. ENTRIES > THEN 
BEGIN 

PRINTFILES; 
WRITE( 'FIX THEM ? • } i 
IF NOT NGETCHAR(TRUE) THEN 
EXIT(CALLPROC) 
END; 

fillchar(bad.sizeof(bad) »o) ; 

FILLCHAR(DIRMAP,SI^EOF(DIRMAP),0) 5 
LOC := 5 

LAST3LOCK : = -10; 

FOR 3LK := FIRSTBLK TO LASTBLK DO 
BEGIN 



C DETERMINE WHAT FILES ARE IN THE BLOCK-RANGE 2 



C PRINT WHAT FILES ARE INDANGERED 3 
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^RlTE( 'BLOCK »tBLK); 
J f !lTRt:AQ<GtNlT.A,FBLKSlZ£.SLK) ; 
JN I UR I TE ( G JN I T i A , F3LK S I ZE i BLK ) J 
IF IORESULT = THEN 

UNITREAD(GUNlTiBiFB|_KSIZEt3LK) ; 
IF (IORESULT = 0) AND (A = B) THEN 

WRITELN< ♦ WAY BE OK » ) 
ELSE 

BEGIN 

WRITELN( ' IS BAD* ) ; 

w'HICHFILE(BLK.TRUE); C IS THE BAD BLOCK IN A FILE 7 3 
IF GDIR <> NIL THEN 

IF BLK > GDIR~ [ 3.QLASTBLK THEN 

BEGIN C CALCULATE THE # OF BAD.XXXX.BAD FILES & WHERE THEY GO 3 
IF LASTBLOCK+1 <> BLK THEN 
BEGIN 

BAD C03. FIRST := BAD COD. FIRST + 1; 

LOC := LOC + l; 

IF LOC > (MAXDIR+DIRMAP.ENTRIES-GDIR* C03.DNUMFILES) THEN 

CHECKRSLT(ORD(INOROOM))5 C NO ROOM TO ADD BAD.XXXX.BAD 3 
BAD CLOC3. FIRST := BLK 
END$ 

BAD CLOC3.LAST := BLK; 
LASTBLOCK := 3LK 
END 

END 

END; 

IF BAD C03. FIRST = THEN 

EXIT(XBLOCKS) ; 
PRINTFILES? C WRITE OUT FILES THAT WILL BE REMOVED IF DIRECTORY IS MARKED 3 
WRITE(*MARK BAD BLOCKS ?•); 
IF DIRMAP. ENTRIES > THEN 

WRITEC (FILES WILL BE REMOVED !>»); 
WRITE(» (Y/N) •); 

if not ngetchar(true) then 

exit(callproc); 
zape|mtries(dirmap. false) ; 

with lde do 

BEGIN 

DFKIND := XDSKFILE? 
DLASTBYTE := FBLKSIZE; 



C REMOVE FILES WITH BAD BLOCKS INSIDE OF THEM 3 
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DACCESS := THEUATE5 
JTlD := '3AD.XXXXX.BAD' 
END: 
FOR MK := 1 TO BAD C03. FIRST DO 
WITH LOEiBADCBLKJ DO 
JEGIN 

OFIPSTBLK ;= FIRST! 
DLASTBLK := LAST+1! 
FOR lOC := 4 DOfclNTO DO 

begin c makes the starting block * part of the file name 3 
dtidc9-loc3 := chr(first div ipotcloc3 + ord(»0 1 )); 
first := first mod ipotcloc3 
end; 
loc := gdir^coj.dnumfiles; 
while dfirstblk < gdir~cloc3.dlastblk do 

LOC := LOC - 1« 

insentry(lde»loc+l»gdir); c add the bad.xxxx.bad file 3 
end; 
updatedir; c write out the new directory 3 

WRlTEfBAD BLOCKS MARKED') 
END CXBLOCKS3 ; 

C ALLOWS THE USER TO OPEN UP THE LARGEST FREE SPACE AVAILABLE ON THE 3 
C DISK AT ANY DESIRED LOCATION 3 

PROCEDURE KRUNCH! 
TYPE 

WAY = (F0URWARD»REVERSEM C DIRECTION FILES ARE BEING MOVED 3 
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VAR 



GINX, SPLIT ,FIRSTBLK,NBLOCKS,RELBLOCK,CHUNKSlZE 
REBOOT! BOOLEAN; 



integer; 



C DOES THE CALCULATIONS FOR MOVING THE FILES 3 

PROCEDURE KRUNCHITCDIRECTION : WAY; VAR STARTING, OTHER : INTEGER; 

STOPPING : INTEGER); 

C DOES THE ACTUAL MOVING OF THE FILES FROM ONE LOCATION TO THE NEXT 3 

PROCEDURE MOVElTdNOUT : SHORTSTRING; BLOCK : INTEGER); 

VAR 

3LKtX, START, STOP : INTEGER! 



2203 


1 


seid 


u 


2209 


1 


os:i 


2 


2210 


1 


56: 1 


1 


2211 


1 


56 :i 


ic 


2212 


x 


56:2 


25 


2213 


X 


56:3 


?. 5 


2214 


1 


56J3 


29 


2215 


i 


56:2 


T9 


2216 


1 


56:i 


35 


2217 


1 


56:i 


33 


221a 




56:2 


! 4 6 


2219 


1 


56:3 


66 


2220 


1 


56."4 




2221 


1 


56:5 


79 


2222 


1 


56 : 4 


92 


2223 


1 


56:5 


94 


2224 


1 


56:4 


107 


2225 


1 


56:5 


113 


2226 


1 


56:6 


113 


2227 


1 


56:6 


180 


2228 


1 


56:5 


184 


2229 


1 


56!4 


184 


2230 


1 


56:3 


186 


2231 


1 


56:0 


192 


2232 


1 


56:0 


216 


2233 


1 


55:o 





2234 


1 


55:1 





2235 


1 


55:2 


8 


2236 


1 


55:3 


18 


2237 


1 


55:4 


16 


2233 


1 


55:4 


35 


2239 


1 


55:5 


40 


2240 


1 


55:4 


57 


2241 




55:5 


59 


2242 


1 


55:4 


73 


2243 


1 


55:4 


97 


2244 


1 


55:5 


120 


2245 


1 


55:4 


130 


2246 


1 


55:4 


138 


2247 


1 


55J4 


142 


2248 


1 


55:5 


142 



START := REL9L0CK; C RELATIVE BLOCK OF THE FILE TO START MOVING FROM 3 
STOP := STAHT+CHJNKSI7E; C LAST REL. BLOCK IN THE FILE TO BE MOVED 1 
IF DIRECTION = REVERSE THEN 

3EGIflJ c M UST NEGATE LOGIC PARAMS GIVEN ARE NEGATIVE & REVERSED 2 
START := -STOP! 
STOP := -RELBLOCK 

END! 

x := o; 

aITH GDIR"CGINX3 DO 

FOR 3LK := BLOCK+START TO BLOCK+STOP-1 DO 

^EGIN C DO CONSECUTIVE READS OR WRITES 1 
IF INOUT = 'READ* THEN 

UNlTREAD(GUNlTi3BUF^CXDtF8LKSIZE,BLK) 
ELSE 

UNITWRlTE(GUNlTtGBUF A CX3,FBLKSlZE«BLKn 
IF IORESULT <> THEN 

BEGIN C TELL USER WHERE IN THE FILE AN ERROR OCCURRED 1 
WRITE (INOUT,* ERROR, REL • ,BLK-BLOCKi ' . ABS '»BLK){ 
EXIT(KRUNCH) 
END; 
X := X+FBLKSIZE 
END 
ENQ; 

BEGIN 

WITH GDIR^CGINXD DO 

IF DFKIND <> XDSKFILE THEN 
BEGIN 

WRITE( 'MOVING »); 

IF DIRECTION = FOURWARQ THEN 

WRlTEf FORWARD*) 
ELSE 

WRITE! 'BACK') ; 



WRITELN( 
IF DTID 

REBOOT 
NBLOCKS 
RELBLOCK 
REPEAT 

CHUNKSI2E 



tUTID); 

= 'system. pascal' then 
:= gvid = syvid; 

:= dlastblk-dfirstblk; 
:= 0; 



:= NBLOCKS 



C IS THIS BEING DONE ON ROOT DISK 

C NUMBER OF BLOCKS IN THE FILE 

C RELATIVE BLOCK TO THE FILES 

C U OF BLOCKS LEFT TO MOVE 



1 
1 



T17 



2249 


1 


ob:5 


143 


^250 


1 


is: 6 


155 


2251 


1 


55:5 


lb? 


2252 


i 


55.*5 


16 9 


2255 


1 


^5:5 


130 


2254 


1 


55:5 


191 


2255 


X 


55:h 


2Ui 


2256 


1 


55:4 


203 


2257 


1 


55:5 


213 


2256 


1 


55:4 


220 


2253 


1 


55:5 


224 


2260 


1 


55:4 


233 


2261 


1 


55:4 


236 


2262 


1 


55:3 


236 


2263 


1 


55 :o 


238 


2264 


1 


55:0 


254 


2265 


1 


54 :o 





2266 


1 


54:i 





2267 


1 


54:i 


24 


2268 


1 


54:1 


75 


2269 


1 


54:i 


84 


2270 


1 


54:i 


39 


2271 


1 


54:i 


92 


2272 


1 


54:i 


101 


2273 


1 


54:i 


104 


2274 


1 


54:1 


110 


2275 


1 


54:2 


123 


2276 


1 


54:3 


129 


2277 


1 


54:4 


141 


2273 


1 


54:1 


162 


2279 


1 


54:i 


169 


2280 


1 


54:2 


185 


2231 


1 


54:3 


191 


2282 


1 


54:4 


191 


2283 


1 


54:5 


197 


2284 


1 


54:4 


205 


2285 


1 


54:3 


205 


2286 


1 


54:1 


216 


2287 


1 


54:1 


251 


2288 


1 


54:2 


254 


2289 


1 


54:3 


254 



IF CHUNKS T^C > GBUF3LKS THEN 

CHUNKSlZt := GBUF3LKS; C 
iJDLOCKS ;= NBLOCKS - CHUNKSIZE5C 
10VEIK MEAD* .STARTING) J C 
ViCVEITC «wKlTE» »STQP D ING) ; C 
RELSLUCK := RELBLOCK+CHUNKSIZE! 
UNTIL NBLOCKS = 0; 
IF DIRECTION = REVERSE THEN 

OTHER := STOPPING - (OLASTBLK - 
ELSE 

OTHER := STOPPING + (DLASTBLK - 
STARTING := stopping; 
UPDATEOIR 
END 
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THE BUFFER ISN'T BIG ENOUGH 
BLOCKS LEFT TO MOVE 
START READING THE FILE 
WRITE IT OUT SOMEWHERE ELSE 



2 
2 
2 
2 



DFIRSTBLK) 
DFIRSTBLK) ; 



NEW DFIRSTBLK : 
NEW DLASTBLK 2 



END 



begin c krunch 3 
checkfile( • crunch • t •• , 1 , blkdexp , false , false » cokdir 3) \ 
6etbl0cks( 'from end of disk, block 1 ♦♦♦ f ' starting at block #». 

gdir* cq3. dlastblk, split)} 
whichfilecsplit, false) ; c which files go which direction ? 3 
reboot := false; c will be set to true if *system. pascal is moved 3 
syscont.miscinfo.nobreak := true; c ignore all break chars. during krunch 3 
clearscreen; 
writelnj 

for ginx := 1 to split-1 do 
with gdir a cginx3 do c move these files towards the first block 3 
if dfirstblk > gdir* cginx-1 3. dlastblk then 
krunchit(f0urward, dfirstblk, dlastblk, gdir a cginx-1 3. dlastblk ) ; 
first3lk := gdir^cod.deovblk; 
for ginx := gdir a c0].dnumfiles downto split do 
with gdir~ cginx3 do c move these files towards the last block 2 

3EGIN 

IF DLASTBLK < FIRSTBLK THEN 

KRUNCHIT (RE VERSE, DLASTBLK, DF I RSTBLK,FIRSTBLK) ; 
FIRSTBLK ;= DFIRSTBLK 

end; 
writeln(gvid, ' : crunched'); 
if reboot then 

BEGIN C *SYSTEM. PASCAL WAS MOVED 2 
WRlTELNf PLEASE RE-BOOT'); 



2^-31 1 54:2 234 EN;"); 

22^3 1 tV> l c III rM ^SC0-i-.rfISCI.-MF0.r>.OBREAK := FALSE 



314 



2294 1 5!t :u 

2295 1 54:0 
229€> 1 54:0 
2297 1 54:0 314 



2295 1 54:0 314 - __ 

229* 1 54:0 314 " "" DRlVER R0U TINE 



„„„ J J :D 1 PROCEDURE CALLPROC; ~ D 

2300 1 2:0 1 VAR 

"I! J J:j 1 X ,Y ; integer; 

"?? J ?:d 3 ok : boolean; 

2303 1 2:D 4 

230S i 1 JiS ? C CALLS O p -SYSTEM PROMPT ROUTINE 3 

23^6 J tVio I PROCEDURE PROHPTEMCSTR : STRING); 

llll J IVi ° PL ;= STR; 

"08 1 57:i 12 PROMPT; 

2310 J llll J? CH := GETCHAR( N OT OK); 

2311 1 57l 27 EnS' :=CHINCt * " ? " ' B ' ' ' ' E ' ' ' G' "K' . . 'N' , 'P. . . .^ . ♦ V . . • X' , - Z ' 3 

2312 1 57.-0 60 

2313 1 2:0 BEGIN 

?!*£ J- ? :1 ° initglobals; 

t\]l } 2:1 2 INSTRING := »»; 

J* 1 * J ? :1 10 ok := true; 

2317 1 211 13 repeat 

l\\\ J 2:2 13 IF FAST THEN 

2320 1 s :3 1& PROMPTEM< 

2321 1 VA 97 '"""Lse"' "^ W<HAT ' "^ L(D1R ' RCEM ' C(HNG ' T(RANS ' D(ATE ' °«"" CII3-) 

2323 1 VA iJJ xF^T^'t^ *' *' "' "' "' C ' T ' °' ° ""•" 

IF FAST THEN 
PROMPTEM( 



2324 1 2:3 148 

2325 1 2m 151 



2327 \ 2.«3 232 '"^ f^'^ 5 ' ECXr-DiR. K <RNCH. M<AKE, PCREFIX, V<OLS, XtAMINE, Z(ERO CII3M 

«H I 2 2 : : 1 2?6 UNTIL «?" "" ' '^ ? "' B ' E ' «' "' P ' V ' *' Z «»•» 
2330 1 2:i 281 HOMEC'JRSOR; 
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f o 



n 



2351 
«332 
2333 
2334 
2335 
2336 
2337 
233b 
2333 
2340 
2311 
2342 
2343 
2344 
2345 
2346 
2347 
2348 
2349 
2350 
2351 
2352 
2353 
2354 
2355 
2356 
2357 
2353 
2359 
2360 
23S1 
2362 
2363 



1 
1 

1 
± 

1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
i 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 



2: i 



2 

2 

2: 

2; 

2; 

2: 

2; 

2 : 

2; 

2; 

2; 

2; 

2; 

2; 

2 

2: 

2: 

2; 

2; 

2; 

2: 

2: 

2; 

2; 

2; 

2 
2 

2; 
2: 
2; 
2: 

2; 
2; 
2: 

2! 

2: 
2; 
2; 
2 



2d 4 
?67 
30 a 
3 C 9 
320 
326 
336 
349 
360 
360 
362 
444 
444 
460 
463 
468 
473 
477 
482 
486 
490 
494 
504 
504 
531 
538 
545 
543 
586 
588 
592 
596 
600 
604 
608 
612 
616 
620 
624 
684 
710 



CLEA 
IF C 

CL 
FOk 
WITH 

If 



i IN 

x : = 

u^ I 

UVI 

FO* 
IF 



CASE 
•L 

i r 

•G 
•N 
•C 
•R 
•T 
•S 
•P 



CH 



• W 

ijVj 

•V 
•B 
♦Z 
•X 

•K 
•D 
»Q 

END 
END J 



c t 

[« » » ' 
CREt'Ni 

1 T2 1 
TABLElX 
J <> •• 

r := x+ 

UVID = 
3EGIN 
WRITE 
WRITE 

WRITE 

end; 

OF 

LISTOIR 
lISTDIR 
3ETW0RK; 
NEWWORK(TRUE) ; 
CHANGER; 
REMOVER; 
TRANSFER; 

IF SAVEWORK THEN TRANSFER; 
BEGIN 
CHECK 



B'i'D'i'Q'.'V'.'Z'D THEN 

1 CO 
J DO 

THEN 
1 TO 12 DO 

LiUlTABLECYD.UVID THEN 

ANDCLEAR? 

(•WARNING UNITS NX.' & «iYi' HAVE THE SAME NAME*)! 

AiiDCLEAR 



(FALSE) 5 
( TRUE) ; 



FILECPREFIX TITLES BY* » " t 1 ♦ VOLEXP»FALSE» 

FALSEtCNOVOL»BADDIR,OKDIR»UNBLKDVOL3) ; 

:= gvid; 

LINE; 

(•PREFIX IS *.DKVIDt':') 



DKVID 
CLEAR 
WRITE 

end; 
whatwork; 

MAKEFILE? 

LlSTVOLS; 

BADBLOCKS! 

ZEROVOLUME! 

XBLOCKS; 

KRJNCH! 

DATESET; 

EXIT(FILEHANDLER) 



MAIN SEGMENT routine 



^372 1 2;j 710 : -._ 

^3 73 1 -i;o 71 rj 

2374 1 i!0 J jEGIN CFlLEHArOLEfU 

^^ 1 i:i WITH U5ERIMF0 ^0 

„„ J Y' 2 l2 3^3 1 Ki C INITIALIZE WORKFILES 3 

J, J -j 3 12 TEXTSAVED := NOT GOTSYM OR (GOTSYM AND (SYMTID <> • SYSTEM. WRK. TEXT •>) J 

237^ \ {'.I + * r| COOESAv/ED := NOT GOTCOOE OR (GOTCODE AND (CODETID <> » SYSTEM. WRK . CODE •) ) 

23I? i J!, 1 ^ mao3 ~ = ifYSCOM-.CRTINFO. WIDTH >= 80) AND (NOT SYSCOM- .MISCINFO.SLOWTERM) | 

;,„ 1 X i' 1 39 MARK(G3UF); Z SET UP TRANSFER BUFFER 3 

2382 i 1:1 103 G8UF8i-KS := c; 

^333 1 i:i ios REPEAT 

2384 1 1:2 106 NEWOlOCKPTR); 

2335 1 1:2 113 GBUF3LKS := GBUFBLKS+1? 

2386 1 1:2 113 

llll \ Y\ 2 JJ 8 C LEAVE R00M F0R FILER VARIABLES TO KEEP FROM STACK OVERFLOWING 3 

2389 1 \'A \£ TIL ft CC ^ MAVAIL > 0) AND ^EMAVAIL < ( SIZEOF ( DIRECTORY>+SIZEOF< FIB) +1024 )) ) 

llll I ;:t 137 °R (63UFBLKS =63); C BLOCK I/O LIMITATION 3 

"qj J 1!1 1!+3 C ABBREVIATIONS FOR THE MONTHS S FILE TYPES 3 

™f J Ji^ ^ 3 ^ONTHSTR := '777JANFEBMARAPRMAYJUNJULAUGSEP0CTN0VDEC?????????'; 

2394 1 1M TYPESTR := • BAD CODETEXTINFODATAGRAFFOTO* 5 

mi I ?4 239 RER EAT c CALL DRIVING ROUTINE IN AN INFINITE LOOP 3 

«»6 1 1:2 239 CALLPROC; 

2397 1 1:2 241 

f!!? J J|^ J^ C T I N CASE WE ABORTED FROM TRANSFER AND LEFT A TEMP FILE 3 

"„ J J.' 2 241 IF UNITABLECDESTUNIT3.UISBLKD THEN 

2 ?°? * 1:3 250 CL0SE(LFIB, PURGE) 

2401 1 1:2 256 ELSE 

2^02 1 1:3 253 CLOSE(LFIB) 

2403 1 l:i 264 UNTIL FALS r 

2404 1 1:0 264 END; 

2405 1 i:o 290 

2<+ °6 1:0 BEGIN 

2407 i:o END. 
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1 

2 
3 

6 

7 

8 

9 

10 

11 

12 

13 

If 

15 

16 

16 

17 

18 

19 

20 

21 

22 

23 

24 

25 

26 

27 

2b 

29 

30 

31 

32 

33 

34 

35 

36 

37 
38 
39 
40 



1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

















































1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

i:d 

i;d 

i:d 

i:d 

i:o 

i:d 

i:d 

i:d 

i:d 

i:d 

i:d 

i:d 

i:o 

i:d 

i:d 

i:d 

i:d 

i:d 

i:d 

i:d 

i:d 

i:d 

i:d 

i:d 

i:d 

i:d 

i:d 

i:d 

i:o 

i:o 

i:d 



i 

i 

l 

l 

l 

l 

l 

i 

l 

i 

l 

l 

i 

l 

l 

l 

l 

l 



l 

l 

l 

i 

l 

l 

l 

l 

l 

l 

l 

l 

l 

l 

l 

l 

l 



*SL PRINTER:*) 
*********************************^ 

SCREEN ORIENTED EDITOR WRITTEN: OCTOBER 11, 1978 t\ 
UPDATE : DECEMBER 10, 1978 *) 

Br RICHARD S. KAUFMANNt / v * } 

T IS ^ 

\ VFRSIOM \ 

UNIVERSITY OF CALIFORNIA, SAN DIEGO \ r 6F \ 

LA JOLLA CA 92093 \ _, , 



COPYRIGHT (C) 1978, BY THE REGENTS OF THE UNIVERSITY OF 
CALIFORNIA AT SAN DIEGO 



*) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 



*******************»*♦*********♦*****.♦„♦„„„„*„*.„„,,,,„,,,„,,,,,,,,,; 



*$I HEAD *) 
*SU-*) 

I CONST 

I I tJ^^m G = 7? ( * NUMBER 0F CHARACTERS IN A VOLUME ID *) 
1 TIOLENG = 155 (* NUMBER OF CHARACTERS IN A TITLE ID *) 

1 TYPE 
1 

DATEREc=PACKED RECORD 

MONTH: 0..12; 

day: o..3u 
year: 0..100 
end; 



vid = stringcvidleng3; 

tid = stringctidleng3; 

inforec = record 

trashi,trash2: integer; 
errsym,errblk,errnum: integer; 
trash3: array co. .23 of integer; 
gotsym,gotcode: boolean; 
workvid»symvid»codevid: vid; 

WORKTId,SYMTID,CODETID: TID 



(* ERROR COM FOR EDIT *) 



(* PERM&CUR WORKFILE VOLUMES *) 
(* PERMSCUR WORKFILE TITLES *) 



fin 



<u 





i:d 


i 


42 





i:d 


i 


43 





i:d 


l 


44 





i:o 


i 


45 





1 • ^ 
-L • U 


i 


46 


u 


i:d 


l 


47 





i:d 


l 


43 





i:d 


i 


49 





i:d 


l 


50 





i:d 


l 


51 





i:q 


l 


52 





i:d 


l 


53 





i:d 


l 


54 





i:d 


i 


55 





i:d 


l 


56 





i:d 


l 


57 





i:d 


l 


58 





i:d 


l 


59 





i:d 


l 


60 





x:d 


l 


61 





i:d 


l 


62 





i:d 


l 


63 





i:d 


i 


64 





i:d 


l 


65 





i:d 


l 


66 





i:d 


l 


67 





i:d 


l 


68 


c 


i:d 


l 


69 





i:d 


l 


70 





i:d 


l 


71 





i:d 


2 


72 





i:d 


8 


73 





i:d 


54 


74 





i:d 


59 


75 





i:d 


67 


76 





i:d 


68 


77 





i:d 


68 


78 


1 


i:d 


1 


79 


1 


i:d 


3 


80 


1 


i;d 


3 


81 


1 


i:d 


3 
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f:nd (*infokec*) ; 

sysccmr^c = record 

junk; array c . . 6 3 of integer; 
lastmp: integer? 

expansion: array co. .203 of integer; 
miscinfo: packed record 

n03reaki stupid »slowterm, 

hasxycrtthas|_ccrt,has8510a*hasclock: boolean 

END; 

crttype: integer; 
crtctrl: packed record 

rlf,ndfs,eraseeol,eraseeos, home. escape: char; 

backspace: char; 

fill-count: 0..255? 

clearscreentclearline: char; 

PREFIXED: PACKED ARRAY CO. .8] OF BOOLEAN 

end; 
crtinfo: packed record 

width, height: integer; 

right, left. downiup: char; 

badch.chardel, stop, break, flush. eof: char! 

altmode.linedel: char; 

backspace. etx, prefix: char; 

prefixed: packed array co. .133 of boolean; 

END 

end usyscom*); 

var (* t . h globals as of 30-jan-78 *) 
syscoh; ^syscomrec; 
trash y : array co. .53 of integer; 
userinfq: inforec; 
trashyy: array co..43 of integer; 
syvid.dkvid: vid; 
thedate: daterec ; 

1 segment procedure editor ( xxx . yyy : integer)! 

3 CONST 

(* UNLESS OTHERWISE NOTED ALL CONSTANTS ARE UPPER BOUNDS 
FROV) ZERO. *) 



32 
63 
31 
85 
86 
87 
88 
89 
90 
91 
92 
93 
94 
95 
96 
97 
98 
99 
100 
101 
102 
103 
104 
105 
106 
107 
108 
109 
110 
111 
112 
113 
lit 
115 
116 
117 
118 
119 
120 
121 
122 



1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 



i:d 
i:u 
i:o 



l 

l 

l; 

1! 

l: 
i; 
i; 

1! 




D 


D 
D 
Q 
D 
D 



i:o 

i:d 

i:d 

i:d 

i:d 

i:d 

i:o 

i:d* 

i:o 

i:d 

i:d 

i:d 

i:d 

i:d 



i 
l: 

l: 
l; 



D 
D 

D 

D 



i:d 
i:d 
i:d 
i:d 
i:d 



l: 

1! 
1! 

i: 



i:d 
i:d 
i:o 



3 
3 
5 
3 
3 
3 
3 
3 
3 
3 
3 
3 
3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 
3 
3 
3 



w IAXBUFsiZE = 32767; 

MAXSW=545 (* MAXIMUM ALLOWABLE SCREENWIDTH *) 

MAXSTRING=127; 

MAXCHAR=1023; (* THE MAXIMUM NUMBER 

TIDLENG=15; (* FROM SYSCOM *) 

(* FOR FINAL VERSION. NOT USED. 
(* MAXIMUM OFFSET IN A PAGE *) 
RIDICULOUS UPPER BOUND! *) 



OF CHARACTERS ON A LINE IN THE EBUF *) 



CHARIN3UF=20«*8! 
MAXOFFSET=1023; 
MAXPAGE=255; (* 



(* THE FOLLOWING ASCII CHARACTERS ARE HARD-WIRED 
HT=9; LF=10; EOL=13; DLE-16; SP=32; 
DC1=17; BELL=7; RUB0UT=1275 CR=13; 



*) 



IN *) 



CHAR; 
OF CHAR; 



TYPE 

PTRTYPE=0..MAXBUFSIZE; 
BUFRTYPE=PACKED ARRAY CO.. 01 OF 
BL0CKTYPE=PACKED ARRAY CO. .5113 

errortype=(Fatal»nonfatad ; 

offset=o..maxoffset; 

page=o..maxpage; 

name=packed array co. .71 of char; 

ptype=packed array c 0. .maxstringd of char; 

C0MMANDS=( ILLEGAL, ADJUSTC ,C PYC , DELETEc ,FINDC , INSERTC JUMPCLISTCMACRODEFC , 

nSL^^c^^^^^E^^^^^^^^^^C'^P^REVERSEC^FORWARDC.UP, 

DOWN, LEFT t RIGHT, TAB, DIGIT, DUMPC, ADVANCE, SPACE, EQUALCtSLASHC); 
CTYPE=(FS,GOHOME,ETOLOL,ETOEOS,US) ; utttwuAi.utai.Aanc J I 

SCREENCOMMAND=(WHOME.ERASEEOS,ERASEEOL,CLEARLNE.CLEARSCN,UPCURSOR, 

DOWNCURSOR,LEFTCURSORtRlGHTCURSOR); 

(BACKSPACEKEY,DC1KEY,E0FKEY,ETXKEY,ESCAPEKEY,DELKEY,UPKEY, 
DOWNKLY,LEFTKEY,RIGHTKEY,NOTLEGAL){ «U^tT, 



KEYCOMMAND= 



HEADERr (* PAGE ZERO LAYOUT CHANGED 22-JUN-78 *) 
RECORD CASE BOOLEAN OF 

TRUE! (BUF: PACKED ARRAYC0..MAXOFFSET3 OF CHAR); 

FALSE! (DEFINED: BOOLEAN; (* NEW FILE NULLS => FALSE *) 

COUNT: INTEGER; (* THE COUNT OF VALID MARKERS *) 
NAME: ARRAY CO. .93 OF PACKED ARRAY CO. .73 OF CHAR; 

pagen: packed array co..9d of page; 
poffset: packed array co..9d of offset; 



1-35 



123 


1 


i:d 


3 


124 


1 


i:d 


5 


125 


1 


i:o 


3 


126 


1 


i:d 


3 


127 


1 


i:d 


5 


128 


1 


i:d 


3 


129 


1 


i:d 


3 


130 


1 


i:d 


3 


131 


1 


i:o 


3 


132 


1 


i:d 


3 


133 


1 


i:d 


3 


134 


1 


i:o 


3 


135 


1 


i:d 


3 


136 


1 


i:d 


3 


137 


1 


i:d 


3 


138 


1 


i:d 


3 


139 


1 


i:d 


4 


110 


1 


i:d 


5 


141 


1 


i:d 


6 


142 


1 


i:d 


7 


113 


1 


i:d 


9 


111 


1 


i:d 


10 


145 


1 


i:d 


11 


146 


1 


i:d 


12 


147 


1 


i:d 


13 


148 


1 


i:d 


14 


149 


1 


i:d 


15 


150 


1 


i:d 


16 


151 


1 


i:d 


17 


152 


1 


i:d 


18 


153 


1 


i:d 


24 


154 


1 


i:d 


80 


155 


1 


i:d 


81 


156 


1 


i:d 


82 


157 


1 


i:d 


83 


158 


1 


i:d 


88 


159 


1 


i:o 


52 


160 


1 


i:d 


52 


161 


1 


i:d 


53 


162 


1 


i:d 


17 


163 


1 


i:d 


81 



end; 



autoindent: 
filling: 

TOKDEF: 
LMARSIN: 

rmargin: 
paramargin: 
runoffch: 
created: 

lastjsed: 
filler: 



BOOLEAN; (* 
BOOLEAN; 
BOOLEAN; 
0..MAXSW; 

o. .maxsw; 

0. . MAXSW J 
CHAR; 

daterec; 
DATErec; 

PACKED ARRAY 



ENVIRONMENT STUFF FOLLOWS 



1 CO 



*) 



CO. .891] OF CHAR) 



<* 


NUMBER OF VALID CHARACTERS 


<* 


GETLEADING *) 


(* 


SETS *) 


(* 


THESE *) 



(* 



OR 



*) 



(* 


MOVED 


TO 


VAR 


26- 


•JAN 


*) 


( * 


it 


ii 


it 


i 


t 


*) 



VAR 

CURSOR; O..MAXBUFSIZE; 
BUFCOUnt: O..MAXBUFSIZE; 

stuffstaRT: o. .maxbufsizei 

linestart: cmaxbufsize; 

bytes. blanks: integer; 

ch: char; 

direction: char; 

repeatfactor: integer; 

bufsize: integer; 

screenwidth: integer? 

screenheight: integer; 

command: commands; 

lastpat: o..maxbufsize; 

ebuf: -bufrtype; 

fillit: stringc113; 

kind: array cchar] of integer? 

line1ptr: 0..maxbufsize; 

middle; integer? 

needprompt: boolean; 

etx,3s,del,esc,bspce: integer; 

adjustprompt,insertprompt,deleteprompt,comprompt: string; 

cpromptline 11/2/78 m. bernard] 

trash: integer; (* totally without redeeming 

target: ptype; 

substring: ptype; 

slength.tlength: integer; (* length of target and substring 



IN THE EBUF *) 



(* for token FIND *) 
(* MIDDLE LINE ON THE SCREEN *) 
(* MOVED FROM CONST 30-JAN-78 BSPCE: 11/2/78*} 



SOCIAL VALUE *) 



*) 



164 1 

165 1 

166 1 



167 

168 

169 

170 

171 

172 

173 

174 

175 

176 

177 

178 

179 

180 

181 

182 

183 

184 

185 

186 

187 

188 

189 

190 

191 

192 

193 

194 

195 

196 

197 

198 

199 

200 

201 

202 

203 

20<f 



1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

3 

5 

7 

9 

9 

9 

9 

9 

9 

9 

9 

1 

1 

1 

1 

1 

1 



1 
1 
1 

1 

1 

1! 

l: 
1! 



i:o 

i:d 

1JD 

i:d 
i:d 
i:d 
i:d 
i:d 
i:d 
i:d 
i:d 
i:d 
i:o 
i:d 
i:d 



:d 

15 

:o 
:o 
:o 
:o 
:o 



1:0 
i:o 

i:o 
i:o 
i:o 

2:d 
3:d 
4:d 
5:d 
6:d 
7:d 



S3 

ab 

S7 

39 

90 

30 

86 

98 

39 

60 

65 

06 

06 

06 

06 

06 

06 

06 

14 

14 

14 

14 

14 

22 








12 
12 
12 
12 
12 
12 
12 

1 

1 

3 

1 

1 

1 



SDEFIN 
COPYLE 
COPYLI 
INFINI 
THEFIL 
TRANSL 
PAGEZE 

msg: S 

PROMPT 
6LANKA 
SAVETO 
SCREEN 



KEYBRD; 



LQiTOEFIN 
NSTH,COPY 
ME»COPYOK 
TY: 300LE 

e: file; 
ate: arra 

RO: HEADE 

tring; 
line: str 
rea: arra 

: STRING 
PACKED 
PREFI 
HEIGH 
CANUP 
HASPR 

ch: 

END; 

PACKED 
PREFI 
HASPR 

ch: 

END? 



ED: boolean; 
start: ptrtypi 
: boolean; 

AN; 



(* WHETHER THE STRINGS ARE VALID *) 

I* FOR COPYC *) 
{* '• *) 

(* FOR SLASHC *) 



Y C CHARD OF COMMANDS; 

r; 



ING; 

Y C0..MAXSWD 

RECORD (* SCR 
X: CHAR; 
TtWlDTH: 0..2 
SCROLL, CANDOW 
EFIX! PACKED 
PACKED 



OF CHAR; 

(* DUMB TERMINAL PATCH - FOR BLANKCRT(l) *) 
EEN CONTROL RECORD *) 

55; 

NSCROLLtSLOW: BOOLEAN; 

ARRAY CSCREENCOMMANDD OF BOOLEAN; 

ARRAY CSCREENCOMMAND3 OF CHAR 



RECORD (* KEYBOARD CONTROL RECORD *) 
x: CHAR; 
EFlx: PACKED 
PACKED 



ARRAY CKEYCOMMAND3 OF BOOLEAN; 
ARRAY CKEYCOMMAND3 OF CHAR 



SEGMENT PROCEDURE NUM2 
SEGMENT PROCEDURE NUM4 
SEGMENT PROCEDURE NUM6 
SEGMENT PROCEDURE NUM8 



(*$I HEAD *) 



BEGIN END; 
BEGIN END; 
BEGIN END; 
BEGIN END? 



SEGMENT 
SEGMENT 
SEGMENT 
SEGMENT 



PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 



NUM3; 
NUM5; 
NUM7 5 
NUM9; 



BEGIN ENDJ 
BEGIN END; 
BEGIN END; 
BEGIN END; 



(* FORWARD DECLARED PROCEDURES.. ALL PROCEDURES ARE IN MISC AND UTIL *) 

procedure error(s:string;howbad:errortype)« FORWARD; 

procedure erasetoeol(x,llne:lnteger) ; forward; 

function getch:char; forward; 

procedure clearscreen! forward! 

procedure eraseos(x,line:integer); forward; 

procedure clearline<y:integeR) ; forward; 



121 



1 c3 



205 

206 

207 

20B 

209 

210 

211 

212 

213 

214 

215 

216 

217 

218 

219 

220 

221 

222 

223 

224 

225 

226 

227 

223 

229 

230 

231 

231 

232 

233 

234 

235 

236 

237 

238 

239 

240 

241 

242 

243 

244 



1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 



8: 

9: 
10: 
ii: 
12: 
13: 
14: 
15: 
16: 
17: 
is: 
19: 
2o:c 
2i:d 
22:d 
22:d 
23:d 
24:d 
25:d 
2&:d 
27:d 
28:o 
29:d 
3o:d 
3i:d 
32:d 
32:d 



32 

1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
2 
2 



:d 
:d 
:d 
:d 
:d 
:d 
:d 
:d 
:d 
:d 
:d 
:d 
:d 
:o 



i 

l 
l 

3 
3 
3 
3 
1 
1 
1 
1 
1 
3 
1 
4 
1 
1 
3 
1 
3 
1 
1 
1 
1 
1 
44 
44 
1 
1 
1 
1 
2 
3 
5 
6 
12 
53 
65 
1 




function 
function 
procedure: 

PROCEDURE 
FUNCTION 
FUNCTION 
FUNCTION 
FUNCTION 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 
FUNCTION 
PROCEDURE 
FORWARD; 
PROCEDURE 
PROCEDURE 
FUNCTION 
PROCEDURE 
FUNCTION 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 

(*$I INIT 

SEGMENT PR 
LABEL l; 
VAR 

block: * 
onewd: " 

DONE.OVF 

ch: char 

IiQUIT,G 
FILENAME 
BUFFER: 

PROCEDURE 
BEGIN 



maptocowmand(ch:char>: commands; forward; 
uclc(ch:char> : char; forward; 
prompt; forward; 
redisplay; forward! 

MlM(At3:iNTEGER) : INTEGER; FORWARD; 

max (a, 8: integer ) : integer; forward; 

screenhasu'hat: screencommand) : boolean; forward; 

haskey(what: keycommand): boolean; forward; 

controhwhat: screencommand); forward; 

putmsg; forward; 

home; forwaru; 

errwait; forward; 

blankcrtu: integer); forward; 

leadblanks(PTr:ptrtype;var bytes: integer): integer; 

centercursorivar line: integer; linesup: integer? 



FORWARD; 

newscreen:boolean) ; 



findxy<var indenTiLine: integer); forward; 

showcursor; forward; 

getnum: integer; forward; 

getleading; forward; 

oktodel<cursor,anchor:ptrtype) :boolean; forward; 

lineout(\/ar ptr;ptrtype; bytes, blanks* line: integer); forward; 

upscreen(firstline»wholescreen:boolean; line: integer); forward; 

readjust(cursor: ptrtype; delta: integer); forward; 

thefixerjparaptr: ptrtypejrfac: integerjwhole: boolean); forward; 

getname(«sg:string; var m:name>; forward; 



*) 

ocedure 



initialize; 



blocktype; 

integer; 

lw: boolean; 

; 

ap,blks,page»notnuls: integer; 

: string; 

packed array co. .10233 of char; 

map(ch:char; c:commands); 
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246 

247 
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250 
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255 

256 
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261 
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266 

267 

268 

269 

270 

271 

272 

273 
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275 
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282 
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285 



10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 



2:i 
2:1 
2:0 
2:0 
3:d 
3:0 

3:1 



3: 

3! 

3: 
3: 
3: 
3: 
3: 



3:1 
3:2 
3:3 
3:3 
3:3 
3:3 
3:2 
3:0 
3:0 
4:d 
4:0 
4:1 
4:1 
4:1 
4:1 
4:1 
4:1 
4:1 
4:1 
4:2 
4:3 
4 



;4 
:5 

■ s 



4:6 

4t6 



TRANSLATED CH J :=C; 

3 IF CH IN C*A*..*Z*] THEN TRANSLATEC CHR ( 32+ORD ( CH ) ) : ; =C ; (* LC TOO *) 

36 end; 
50 

1 PROCEDURE DEFPROMPTS; <* DEFINES VARIABLE PROMPTL.INES MAB 11/2/78*) 

BEGIN 

comprovipt: = 

3 • EDIT: ACDJST C(PY D(LETE FUND KNSRT J(MP RtPLACE Q(UIT XtCHNG Z(AP CE.6F3*; 

insertprompt:= 

• insert: text c<bs> a char,<del> a lined c<etx> ACCEPTS, <ESC> ESCAPES]*; 

DELETEprOMPT:= 

• DELETE: < > <M0VING COMMMANDS> C<ETX> TO DELETE, <ESC> TO ABORT]*; 

adjustprompt:= 

• ADJUST: L(JUST R(jUST C(ENTER <left, right, up, down-arrows> c<etx> to leaved*; 

IF (SCREENWIDTH+l)<LENGTH(COMPROMPT) THEN 
BEGIN 

INSERTPR0MPT:=* INSRT: C<BS>,<DEL>D C<ETX> ACCEPTS, <ESC> ABORTS]' J 

deleteprompt:=» delete: <VECTOR keys> C<ETX> deletes, <ESC> ABORTS]*; 
adjustprompt:=» adjst: l(ft r(ght c(ntr <vector keys> <etx> to leave*; 
comprompt:=* edit: a, c, d, f, i, j, r, q, x, z ce.6F]»; 

END; 

62 end.; 

76 

1 PROCEDURE READFILE! 
BEGIN 

clearscreen; (* dumb terminal patch *) 
writelnoedit:*); 
write( *reading*) ; 

IF BL0CKREAD(THEFILE»PAGEZER0,2)<>2 THEN ERROR{ 'READING FILE* , FATAL) ; 
WRITE(*.») ; 

page:=i; 

done:=false; ovflw:=false; 
with userinfo do 
while not (done or ovflw) do 

BEGIN 

DONE:= BLOCKREAD(THEFILE,3UFFER,2)=0; 
IF NOT DONE THEN 
BEGIN 

WRITE( *.*) J 

NOTNULS : =SCAN( -1024, <>CHR(0),BUFFERC 10233) + 1024 J 
OVFLW :=NOTNULS+BUFCOUNT>=3UFSIZE-10; 



85 
88 
65 
68 
38 
41 
21 
32 
32 
90 
50 
11 
62 



3 
25 
42 
83 
91 
95 
03 
03 
13 
13 
36 
42 
42 
50 
72 



tm 



236 10 4.*6 04 

287 .10 456 33 

4!& 05 

4.'6 25 

290 10 4!6 32 

291 10 4:5 40 



130 

IF OVFLW THEN NOTNULS : =0 ; 

%l' ,'n I- «f HOVELEFT(bUFFERC03tE3UF-CBUFCOUNTD,NoTNULS); 

239 to 111 °l IF PAG E>PAGE=ERR6LK THEN CURSOR : =BUF C OUNT+ERRSYM ; (* ERRBLK>0 ONLY *> 

" ,Jy 1C *'*> ^ 5 BUFCOUNT:=BUFCOUNT + NOTNULS; 

page:=page+i; 
END; 

29 2 10 4!3 40 EN D ; 

HI *2 JjJ 42 , IF I0RESULTO0 THEN LRRORCDISK ERROR • .NONFATAL ) ELSE 

295 in J:? SI Mn IF N ° T ° 0NE ™ EN ERROR ('BUFFER OVERFLOW. •, NONFATAL ) ; 
C?J A u "+ . u y& END; 

296 10 4:o 12 

297 10 s:d i PROCEDURE LOADFROMSYSCOM; 

299 10° 5«n 1 l * AMn A , T n E nc P rT VER I ED PR0CEDURE THAT TAKES THE SYSCOM~. CRTCNTRL RECORD 

300 iS tin i JK D n° ADS IT INT ° ™ E SCREEN CONTROL RECORD AND THE SYSCOM^.CRTINFO 
30? \° n 1'° \ c RECORD AND LOADS IT INTO THE KEYBOARD CONTROL RECORD *) 

JUi iy J 3«Q u BEGIN 

302 io s:o 

303 io s:i WITH syscom a do 

30£+ 10 5:2 5 BEGIN 

305 10 5:2 5 

306 10 5:2 5 (* MISCELLANEOUS STUFF *) 

307 10 5:2 5 

HI 10 5:3 5 WITH SCREEN DO 

309 jo 5:4 5 BEG i N 

J *° l\l 5 PREFIX:=CRTCTRL. ESCAPES 

"J jo s.s 14 height:=crtinfo.height-u 

IW i« = :5 25 width:=crtinfo.width-i; 

tiu in V.? it canupscroll:=true; candownscroll:=false; 

0Xl+ 10 5:4 50 c"nd; 

315 10 5:4 50 



316 10 5:3 50 

317 10 5:3 59 

318 10 5:3 59 

319 10 5:3 59 

320 10 5:3 59 

321 10 5:3 70 

322 10 5:3 86 

323 10 5:3 86 

325 10 5-3 11 SC REEN. HASPREFIXCERASEEoS3:=CRTCTRL.PREFIXEDC3J{ 

326 10 5:3 13 



KEY3RD. PREFIX IrCRTlNFO. PREFIX 5 
(* THE SCREEN ... *) 

SCREEN. CHCWHOME 3 :=CRTCTRL. HOME! 

SCREEN. HASPREFIXCWHOME 3: =CRTCTRL.PREFIXEDC43; 



SCREEN. CHCERASEEOS 3 :=CRTCTRL.ERASEEOS; 
SCREEN.HASPREFIXCERASEE0S3:=CRTCTRL.PR 

SCREEN. CHCERASEEOL 3: =CRTCTRL.ERASEEOLl 
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10 
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10 


5:3 


4 
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10 


5:3 
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10 


5:3 


51 


331 


10 
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67 
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10 


5:3 


67 


333 


10 


5:3 


78 


334 


10 


5:3 


94 
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10 


5:3 


94 
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10 


5:3 


05 
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10 
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21 
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10 


5:3 


21 
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10 


5:3 


27 


340 


10 


5:3 


36 


341 


10 


5:3 


36 


342 


10 


5:3 


47 


343 


10 


5:3 


63 


344 


10 


5:3 


63 


345 


10 


5:3 


74 


346 


10 


5:3 


90 


347 


10 


5:3 


90 


348 


10 


5:3 


90 


349 


10 


5:3 


90 


350 


10 


5:3 


98 


351 


10 


5:3 


14 
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10 


5:3 


14 


353 


10 


5:3 


20 


354 


10 


5:3 


29 


355 


10 


5:3 


29 


356 


10 


5:3 


40 


357 


10 


5:3 


56 


358 


10 


5:3 


56 


359 


10 


5:3 


67 


360 


10 


5:3 


83 


361 


10 


5:3 


83 


362 


10 


5:3 


94 
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10 


5:3 


10 


364 


10 


5:3 


10 


365 


10 


5:3 


21 


366 


10 


5:3 


37 


367 


10 


5:3 


37 



SCREEN.HASPREFIXCERaSEE0L3:=CRTCTRl.PREFIXEDC23j 

SCREEN. CHCCLEARLNED:=CRTCTRL.CLEARLINEi 

SCREEN. HASPREFIXCCLEARLNE 3: =CRTCTRL.PREFIXEOC73; 

SCREEN.CHCCLEARSCN3:=CRTCTRL.CLEARSCREEN5 

screen.hasprefixi:clearscnj:=crtctrl.prefixedc6 3; 

screen. chcupcursor 3 :=crtctrl.rlf; 
screen.hasprefixcupcursoR3:=crtctrl.prefixedco3; 

screen. chcdowncursor3:=chr(lf) ; 
screen. hasprefixcdowncursor 3 :=falsej 

SCREEN. CHCLEFTCURSOR 3 :=CRTCTRL. BACKSPACE 5 

SCREEN. HASPREFIXCLEFTCURS0R3:=CRTCTRL.PREFIXEDC1 3; 

SCREEN. CHCRIGHTCURSOR 3 :=CRTCTRL.NDFS! 

SCREEN. HASPREFIXCRlGHTCURSOR3:sCRTCTRL.PREFIXEDC83 1 

(* ... AND THE KEYBOARD *) 

KEYBRD,CHCBACKSPACEKEY3:=CRTINF0. BACKSPACE J 
KEYBRD.HASPREFIXCBACKSPACEKEY3:=CRTINF0.PREFIXEDC123; 

KEYBRD.CHCDC1KEY3:=CHR(DC1); ( * NOT IN RECORD *) 
KEYBRD,HASPREFlXCDClKEY3:rFALSE{ 

KEYBRD.CHCEOFKEY3:=CRTINFO.EOF! 
KEYBRO.HASPREFIXCEOFKEY 3: =CRTINFO. PREFIXEDC 93 ; 

KEYBRD.CHCETXKEY3:=CRTINF0.ETX; 
KEYBRD.HASPREFIXCETXKEY3:=CRTINF0.PREFIXEDC133; 

KEYBRD,CHCESCAPEKEY3:=CRTINF0.ALTM0DE; 
KEYBRD.HASPREFIXCESCAPEKEY3:=CRTINFO.PREFIXEDC10 3; 

KEYBRD.CHCDELKEY3:=CRTINF0.LINEDELJ 
KEY3RD.HASPREFIXCDELKEY3;=CRTINF0.PREFIXEDC113{ 

KEYBRD.CHCUPKEY3:=CRTINFO.UP; 



iSl 



133 

368 10 513 48 KEY3RD.HASPREFIXCUPKEY3:=CRTINF0.PREFIXEDC3J: 

369 10 513 64 

370 10 5:3 64 KEY3rtD.CHCDOWNKEY3:=CRTlNFO.DOWNI 

371 10 5:3 75 KEY3RD.HASPREFIXCDOWMKEYD:=CRTINF0.PREFIXEDC23; 

372 10 5:3 91 

373 10 5:3 91 key3Rd.chcleftkey::=crtinfo.left; 

37i+ 10 5:3 02 KEYBRD.HASPREFIXLLEFTKEY3:=CRTINF0.PREFIXEDC13; 

375 10 5:3 18 

376 10 5.*3 13 KEY3RD.CHCRIGHTKLYD:=CRTINF0. RIGHT; 

377 10 5:3 29 KEYBRD.HASPREFIXCRIGHTKEYJ:=CRTINFO.PREFIXEDC03; 

378 10 5:3 45 

379 10 5:3 45 BSPCE:=0RD(CRTINF0. BACKSPACE); CWENT SOFT 11/2/78 M. BERNARD} 

380 10 5:3 51 

381 10 5:3 51 CNOW TEST TO SEE THAT THE ESSENTIAL KEYS HAVE BEEN GIVEN A 

382 10 5:3 51 VALUE OTHER THAN NULL. IF NOT THEN ASSIGN THEM A DEFAULT 

383 10 5:3 51 VALUE. HOPEFULLY, THIS WILL END UP AN INTERP CHANGE— M. BERNARD} 

384 10 5:3 51 

385 10 553 51 IF BSPCE=0 THEN BSPCE:=8; 

386 10 5:3 62 IF KEYBRD.CHCETXKEY3=CHR(0) THEN KEYBRD.CHCETXKEY3I=CHR (3 ) 5 

387 10 5:3 77 

388 10 5:3 77 

389 10 5:2 77 END? 

390 10 5.*0 77 ENDS 

391 10 5:0 90 

392 10 6:D 1 PROCEDURE MAPSPECIAL ( K :KEYCOMMANDS J C ICOMMANDS) ? 

393 10 6J0 BEGIN 

394 10 6!1 IF NOT KEYBRD.HASPREFIXCKD THEN MAP(KEYBRD.CHCK3tC) ; 

395 10 6:0 19 END; 

396 10 6:0 32 

397 10 i:o BEGIN 

398 10 111 WITH PAGEZERO DO 

399 10 i:2 BEGIN 

400 10 1:2 

401 10 1:2 (* L OAD SCREEN AND KEYBOARD CONTROL RECORDS FROM SYSCOM *) 

402 10 i:2 

^03 10 1:3 LOADFROMSYSCOM; 

404 10 i:3 2 

405 10 1:3 2 

406 10 1:3 2 <* iNIT THE TRANSLATE TABLE *) 

407 10 1:3 2 

1+03 !0 1:3 2 FlLLCHAR<TRANSLATE.SlZEOF(TRANSLATE)tILLEGAL) ! 
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21 
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10 


1:1 


89 
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119 
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MAP( »A« .ADJUSTC) ! MAP( 

^AP( •FSFINDC) ; M A p ( 

MAP(»L»tLISTC); MAP< 

MAP(»Q», QUITO ; MAP( 

MAP( 'V«,VERIFYC) 5 MAP( 

MAP( •, »,REVERSEC) ; MAP( 

MAP( •♦•♦FORWARDC); MAP(' 

MAP( •/• .SLASHC) 5 MAPC 



'CCOPYO ; 
'I'.INSERTO 5 
'M« ,V!ACRODEFC) 

R'iREPLACEC) ! 

X»,XECUTEC) ; 

>• »F0RWARDC) ; 

-•tREVERSEC) ! 

=*,EQUALC) ; 



MAP( »D»,DELETEC) ; 
MAP(»Jt,j UMPC) . 

MAP('P»,PARAC) ; 
MAP(»S« t SETC) ; 

»z»»zapc) ; 

.•iFORWARDC) ; 
MAP( '?»,DUMPC) ; 
MAP(»<»,REVERSEC> J 



MAP( 
MAP( 



AND GETNUM HANDLE VT-52 STYLE VECTOR KEYS *) 



(* ARROWS *) 

(* NEXTCOMMAND 
WITH KEYBRD DO 
BEGIN 

MAPSPECIAL(UPKEY.UP) ; MAPSPEClAL(DOWNKEYtDOWN) « 
MAPSPECIAL(LLFTKEY.LEFT) ; MAPSPECIAL (RIGHTKEY, RIGHT) 
END i 

MAP(CHR(EOL), ADVANCE); (* CR IS ADVANCE *) 

MAP(CHR(HT),TAB)! 

MAP(CHR(SP), SPACE); 



(* DIGITS *) 

FOR CH:=«0» TO »9» DO MAP ( CH. DIGIT) ; 

(* VARIABLE BUFFER SIZING... ADDED 17-JAN-78 *) 



(* SIZE0F(EDITC0RE)-SIZE0F(INITIALIZE) *) 
(* SLOP! *) 



QUIT:=10512+ 
512; 

mark(ebuf); 
blks:=o; 

REPEAT 

NEW(BLOCK) ; 

BLKS:=BLKS+l; 

GAP :=MEMAVAIL+MEMA VAIL 
UNTIL <<GAP>0) AND (GAP<QUIT)) OR (BLKS=63); 
BUFSIZE:=BLKS*512-1; ' 

NEW(ONEWD); ONEWD-:=0; (* SENTINEL FOR END OF BUFFER - FOR M(UNCH *) 
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FRONT OF ALL CONTROL CH'S*) 



(* OPEN THE W/ORKFILE *) 

(*INIT FILLIT FOR WRITING NULLS IN 
FILLCHAR(FILLI T ,SIZEOF(FILLIT),0); 
IF SYSCO*r.CRTCTRL.FILLCOUNT<=ll THEN 

FILLITC0 3:=CHR(SYSCOM-.CRTCTRL.FILLCOUNT) 

EL. I— o fc. 

FILLITC03:=CHR(11); 

FILLCHAR(EBUF~,BUFSIZE+1,CHR(0)); 
E8UF A COJ:=CHR(EOL); 

bufcount:=i; 
cursor:=i; 

CLEflRSCREEN! 

WRITELN( «>edit:») ; 

IF USERINFO.GOTSYM THEN 
BEGIN 

ELSE 
BEGIN 

msg: = 

•WMjWFILE IS PRESENT. FILE? ( < RE T> FOR NO FIL E <ESC-RET> TO EXI T , ., 

WRITELN((wiSG); 
WRITEC: •); 

REAOLNdNPUT. FILENAME); 
IF LENGTH(FILENAME)=0 THEN 
BEGIN 

Ew FILLCHAR( P AGEZERO,SIZEOF(PAGEZERO>,CHR(0)); GOTO 1! 

IF FILENAMECLENGTH(FILENAME)D=».» THEN 
DELETE(FILENAME,LENGTH(FILENAME),1){ 
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0pen0ld(thlfile, filename) ; 
msg: = »imot present, fil^' ♦; 

UNTIL IORESULT=05 

end; 



(* read in the file *) 
dfile; 

IF (EBUF-CBUFCOUNT-UOCHR(EOL)) OR <BUFC0UNT=1) THEN 

£G IN lu " 



REadfile; 
1: 

BE 

ebuf~cbufcountd:=chr(eod ; 
bufcount:=bufcount+i; 

END! 



(* initialize everything else! *) 
direction:=»>»; 

cS?wJ=fJJsE? INIT T ° THE BEGINNING 0F THE BUFFER (FOR EQUALC) *, 

lineiptr;=i; 

( * RECORDS . J* 1 YET G ° THR ° UGH ™ E SCREXN AND KEYBOARD CONTROL 

WITH SYSC0M A .CRTINF0 DO 
BEGIN 

esc:=ord(altmode) ; 
bs:=ord(chardel); 
del:=ord(lineded ? 
screenwidth:=width-i; 
screenheight:=height-h 
middle:=(screenheight div 2) + 1$ 
end; 

Mlp;cw?BSnLE?TM CETXKEY: " i CCHANS " FR °" STSC0M "SIG N « N T U/2/78 KAB3 
EmSPJSxkKKIJobRMK == TRU Ei '* ^ B * CKS "" «Y FOR NOW .) 

c including the command prompt LiNEn 
defprompts; 

W?TH X PAGE2ER0 S D0 TDEFINED:=FALSE{ <* NO SUBSTRING OR TARGET •) 

IF NOT DEFINED THEN 
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END ( * 



BEGIN 

fillchar(buf,1024,chr(0) ) ; 

created :=thedate; lastused:=thedate; 

tokdef:=true; <* default mode is t<oken *) 

filling:=false; autoindent:=true; RUnoffch:=»~» ; 

lmargin:=o; paramargin:=5; rmargin:=screenwidth; 

defined:=true; 
end; 
with *) ; 



1 Jo 



(* initialize the kind array for token find *) 



for ch:=chr(0) 

FOR CH^'A* to 

for ch:=»a» to 
for ch:=*o' to 



TO CHR<255) DO KINOCCHD: =ORD(CH) ; 
♦Z» DO KlNDCCH3:=ORD(»A») J 
'Z* DO KINDCCH3:=ORD( 'AM! 
*9» DO KINDCCHDlsORDC'A*)! 



(* MAKE THEM ALL UNIQUE *) 



KINDCCHR(EOL)3:=ORD(» •)! KINDCCHR(HT) 1 :=ORD<» 
FILLCHAR(BLANKAREA,SlZEOF(BLANKAREA) » * • ) 1 
SAVETOp:=»»; 

END(* INITIALIZE *) ; 



(*$I INIT *) 
(*$I OUT *) 

SEGMENT FUNCTION OUT: BOOLEAN; 

LABEL 1,2; 

VAR 

save: ptRType; 
i: integer; 

BUF: PACKED ARRAY CO. .10233 OF CHAR; 
FN: STRING; 
BEGIN 

OUT;=FALSE; 
REPEAT 

CLEArsCREEN! (* DUMB TERMINAL PATCH *) 

savetop:=»>quit: t ; 

WRITELN(SAVETOP); 

WRITELNC U(PDATE THE WORKFILE AND LEAVE* )\ 

WRITelNC E(XIT WITHOUT UPDATING*) J 
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WRIT-, L nJ' S! E It^ N T ° TH - EDIT0R WITH0UT UPDATING.)! 

Slc.getch?;* 1 ' T ° A FILE NSME m0 «™™'>< 

UNTIL CH IN C'U« t •£•» 'R»f «W» J; 
IF CH=»R» THEN GOTO 2; 

closecthefil™, 6 " 1 " 0UT:=TRUEi clwrscreen, GOTO 2 ENDi 

IF CH='W t THEN 
BEGIN 

save:=cursor; 

BLANKCRT(l) ; 

XSElnIKm ° F ° UTPUT FILE (<CR> T ° RETURN > ">•>! 
IF LENGTH(FN)=o THEN GOTO 2; 

rc R J; = l T ° L ^NGTH(FN) DO FNC I 3:=UCLC (FNC 13) ; 
1 ( ^?, S(, - TEXT,fFNK>LE:NG TH(FN)-4, OR CLENGTHfFNX-mi ANn 
(FNCLENGTH(FN)3<>'.») THEN H(FNJ<-4) ) AND 

FNrsCONCATtFN.'.TEXTM; 
Zm FNCLENGTH(F N)3=».. THEN DELETE(FN,LENGTH(FN),1)J 
ELSE 

fn; = »*system.wrk.text» j 

BLANKCRT(l); 

write(»wRIting»); 

0PENNEW(THEFILE»FN); 

pagezero.lastused:=thedate; 

Jr^KWRITECTHEFILE.PAGEZERO^) ° 2 ™ EN G0T0 l « 
CURS0R;=1J ' 

WHILE CURSOR < BUFCOUNT-1023 DO 
BEGIN 

i:=SCAN(-1022,=CHR(EOL) ,E3UF^CCURS0R+1022D) J 

NOVELEFT<EBUF*cCURSOR3,BUF f 1023+lM 

FlLLCHAR(BUFCl023+n,ABS(I)+l,CHR(0))i 

IF BL0CKWRITE( T HEFILE,BUF,2) <> 2 THEN GOTO li 

CURS0R:=CURS0R + 1023+I; 6 ° ° lj 

wRitec.m; 

end; 
if curs0r<bufc0unt then 

BEGIN 

FILLCHAR(BUF.SIZEOF(BUF),CHR<0>>; 
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MO VELEFT(E3UF A C CURSOR :»BUF,3UFC0UNT-CURS0R) ; 

IF BLOCKwRITE<THtFIl_E«BUFt2) <> 2 THEN GOTO U WRITEC') 

end; 
closecthefile.lock) ; 

WRITELN; 

WRITELN( 'YOUR FILE IS »,BUFCOUNT,' BYTES LONG.'); 

IF CH='U' THEN 

WITH USERINFO DO 
BEGIN 

symvid:=syvidj symtid:='system.wrk.text» ; gotsym:=true; 
openold(theflle.'*systew|.wrk.code»> ? close < thefile. purge ) ; 
gotcode:=false; codetid: = "; out:=true; 

END 
ELSE 
BEGIN 

WRlTECDO YOU WANT TO E(XIT FROM OR R(ETURN TO THE EDITOR? ')! 
REPEAT CH:=UCLC(GETCH) UNTIL CH IN C»E , « , R , 3; 
out:= CH='E»; 

cursor:=saves <* QW returns TO THE EDITOR *) 
END; 
GOTO 2} (* SORRY ABOUT THAT EDSGER *) 
i: ERROR( 'WRITING OUT THE FILE • .NONFATAL) ; 
2:END; 



(*$I OUT *) 

(*$I COPYFILE *) 

SEGMENT PROCEDURE COPYFILE5 

VAR 

startpage. stoppage, startoffset.stopoffset. 
leftpart.page.notnulls.therest.lmove: integer; 

DONEtOvFLWj BOOLEAN; 

bufr: packed array cq. .10233 of char; 
startmark.stopmark: packed ARRAY CO. .7] of char; 
FN: STRING; 
f: file; 

procedure errmarker; 

3EGIN 

ERRORJ 'IMPROPER MARKER SPECIFICATION. • .NONFATAL) 5 



653 12 2.-1 37 EXIT(COPYFILE) 

654 12 2:0 HI e nd; 

655 12 2:o 54 

656 12 3:D 1 PROCEDURE UNSPLITBUF; 

fH J 2 3:D X (* ST ICH THE BUFFER BACK TOGETHER AGAIN. *) 

658 12 3:0 BEGIN 

HI \\ X\\ ° MOV ELEFT(EBUF-CTHEREST3,EBUF-CCURSORD,LMOVE)5 

ff? \\ I' 1 13 READJUST(LEFTPART+i,CURSOR-(LEFTPART+l)>; 

III l2 3>1 28 bufcount:=bufcount+cursor-(leftpart+i>; 

663 ^ sjj II EN ^ RS0R :=^FTPART + l; <* CURSOR POINTS TO THE BEGINNING OF THE FILE *> 

664 12 3:0 58 

665 12 4ID 1 PROCEDURE READERR; 

666 12 4:0 BEGIN 

HI \l Jl J J ERROR( 'MARKER EXCEEDS FILE BOUNDS. • .NONFATAL) 5 

668 12 <+:i 34 UNSPLlTBUFF? 

669 12 4!1 36 CENTERCURSOR(TRASH, MIDDLE, TRUE) 5 

670 12 Uli 46 EXIT(COPYFILE) 

671 12 4:o 50 ENDI 

672 12 4:0 62 

673 12 5:D 1 PROCEDURE SPLITBUFJ 

675 \\ ?!5 \ { * VeHl T ^ BUFFER AT THE CURS0R « THEREST POINTS TO THE RIGHT PART, LMOVE 

til if B.'S J ILV! E L 5 N6TH ° F THE RIGHT PART » LEFT PART POINTS TO THE END OF THE 'LEFT 

riS J? * D X p ART», AND CURSOR REMAINS UNCHANGED. *) 

677 12 510 BEGIN 

678 12 5:1 THEREST:=BUFSIZE-(BUFCOUNT-CURSOR); 

°l 3 xz 5: i a lmove:=bufcount-cursor+i; 

°l° 12 5: 1 16 LEFTPART.*=CURSOR-l; 

III " I] 1 22 M °VERIGHT(EBUF-CCURS0RD,EBUF-CTHEREST3, LMOVE) 

682 12 5!0 35 END? 

683 12 5:0 48 

684 12 6:d 1 PROCEDURE PARSEFN; 

685 12 6:d 1 VAR I ,LPTR.RPTR, COMMA: INTEGER? 

686 12 6!D 5 MARK: STRING? 

687 12 6:0 BEGIN 

688 12 6:1 LPTR:=P0S(»C»,FN); 

689 12 6:1 15 IF LPTRrO THEN 

690 12 6:2 20 BEGIN <* WHOLE FILE *) 

691 12 6:3 20 STARTMARK:= f •; 

692 12 6:3 37 STOPMARKI= • « 

693 12 6:2 41 END 
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Mn 

ELSE 

BEGIN 

rptr:=pos( »3»t'FN) ; 

IF (RPTR = 0) OR (RPTR<l_PTR) OR ( RPTROLENGTH( FN ) ) THEN ERRMARKER; 
MARK:=COPY(FNtLPTR+l»RPTR-LPTR-l) 5 (* STUFF BETWEEN THE BRACKETS *) 
FN:=COPY(FNtl,LPTR-l) 5 
COi«IMA:=POS( • t »,MARK) J 
IF COMMA=0 THEN ERRMARKER; 

I :=LENGTH( MARK) -COMMA » (* SECOND MARKER PTR *) 
MOVELEFT(MARKCl3iSTARTMARK,MIN(8iCOMMA-l) ) ; 
FILLCHAR(STARTMARKCCOMMA-1D,MAX(0»8-(COMMA-1) ) ,» ») ; 
M0VEI_EFT(MARKCC0MMA + 1:.ST0PMARK»MIN(I«8) > J 
FlLLCHAR(STOPMARKCn»MAX(0«8-I) t » M 
END? 
FOR i:=o TO 7 DO STARTMARKC I 3:=UCLC ( STARTMARKC I 3) ; 
FOR i:=0 TO 7 DO STOPMARK C I 3:=UCLC (STOPMARKC 13) ? 
FOR l:=l TO LENGTH(FN) DO FNCI 3!=UCLC (FNC I 3) ; 
IF ((P0S( , .TEXT»»FN)<>LENGTH(FN)-4) OR 

(LENGTH(FN><=4>) AND <FNCLENGTH(FN)3<>«.M THEN 
FN:=CONCAT(FNt».TEXT»)» 
IF FNC LENGTH ( FN )3s».» THEN DELETE<FN»LENGTH<FN) . 1 ) ; 
END? 

PROCEDURE STUFFIT ( START . STOP INTEGER ) J 

(* PUT THE CONTENTS OF BUFR INTO EBUF. OVFLW IS SET TO TRUE WHEN THERE IS 

no more room in the buffer. *) 
var amount: integer; 

BEGIN 

IF START<=STOP THEN 
BEGIN 

AMOUNT :=STOP-START+i; 

IF CURSOR+AMOUNT+250(*SLOP*)>=THEREST THEN 
BEGIN 

errort 'buffer overflow. • .nonfatal ) ; 

unsplitbuff; 

centercursor< trash t middle* true) ; 

exit(copyfile) 

END 
ELSE 
BEGIN 

MOVELEFTtBUFRC START D.EBUF^C CURSOR D. AMOUNT) ; 



Ill J? I: 7 cursor:=cursor+amount 

737 12 7:2 61 END 

738 12 7:o 81 END; 

739 12 7:o 94 

™? J 2 , 8:d x p ro cedure getnext; 

7*1 12 8:0 BEGIN 

743 \\ HI 27 2rI E:= ? L ? C ^ READ<F,BUFR,2,PAGE+PAGEK>2; 

7*5 12 l\\ 56 JCsKowSLS " -S I N0TNULLS S =SC AN C -102* . OCHR C 1 v BUFRC1023 3 » ^3.02* 

7a5 Jo S J1 69 p AGE:=PAGE + ll' 

7*7 12 8.*0 77 END; 

7*8 12 8:0 90 

111 \l 9:D l PROCEDURE CHKOVFLW; 

750 12 9:o BEGIN 

752 It ViZ J IF B ^T0POFFSET>=NOTNULLS) AND (STOPPAGE<PASE) THEN 

754 \l V\ II STOPPAGE I =ST0PPA6E*U 

755 \l 1:1 » stopoffset:=stopoffset-notnulls* 

' 33 1< ?»2 35 END! 

756 12 9:o 35 ENDJ 

757 12 9:o «f8 

III \l JSiS X PR0CE DURE FINOMAUKCRSI 

760 12 lolo I {ar SIVEN STARTMARK AND STOPMARK FIND OUT THEIR PAGE NUMBERS AND OFFSETS *> 

III \\ iV° X PZ: HEADER! 

762 12 10:d 13 

76^ " uJd 8 VAR CEDURE SEARCH(MNAME:NAME ' VA R OFF, PNUM: INTEGER); 

HI }f «*° a i, integer; 

766 12 11:0 BEGIN 

767 12 11:1 Z:=0| 

769 J! IJiJ A tS 1 ^ i£< p Z'COUNT> AND f MNANEOP2.NANECZ3) DO l: = I+ll 
7?n to ,f I J 34 IF MNAMEOP2.NAMECID THEN i? 

770 12 11:2 47 BEGIN 

772 12 it I, J 7 ERR0R( 'MARKER NOT THERE. • .NONFATAL) 5 

''Z " J*' 3 71 UNSPLITBUFF; 

774 12 JJ:| I7 EXIT(COPYFILE) 
'' H 12 11.2 77 END; 

775 12 li:i 77 OFF:=p2.POFFSETCl3S 



I r<rk, 
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Jt "±d 

776 12 li:i 86 PNUM:=PZ.PAGENCn; 

777 12 li:i 93 IF PnuM=0 THEN 

778 12 11:2 99 BEGIN 0FF:=0FF-1! PNUM:=1 END; (* KLUDGE TO MAINTAIN COMPATIBILITY *> 

779 12 li:0 08 END; 

780 12 li:o 22 

781 12 10:0 3EGIN<* FlNDMARKERS *) 

782 12 10:1 startpage:=i; startoffset:=o; (* default values *) 

783 12 10:i 8 STOPPAge:=327675 STOPOFFSET :=32767 ! 

781 12 10:i 20 IF (STARTMARKO* • ) OR (STOPMARKO' •) THEN 

785 12 10:2 59 BEGIN 

786 12 10:3 59 IF BL0CKREAD(F,PZ»2 , ) <>2 THEN READERR? 

787 12 10:3 80 IF STARTMARK<>» ♦ THEN SEARCHt STARTMARK ,STARTOFFSET«STARTPAGE) 5 

788 12 10:3 12 IF STOPMARKO* » THEN SEARCHt STOPMARKt STOPOFFSET .STOPPAGE) 

789 12 10:2 12 END 

790 12 10:0 11 end; 

791 12 10:0 56 

792 12 110 BEGIN 

793 12 i:i PROMPTLlNE:=» COPY: FROM WHAT FILECMARKER»MARKER3? »; 
791 12 111 59 REPEAT 

795 12 i:2 59 PROMPT; 

796 12 i:2 62 READLN(FN); 

797 12 1:2 78 IF LENGTH(FN)=0 THEN EXIT ( C0PYFILE) ; 

798 12 1:2 91 PARSEFN? 

799 12 i:2 93 RESET(FtFN); 

800 12 1:2 01 promptline:=» copy: FILE NOT PRESENT, FILENAME? »; 

801 12 111 17 UNTIL IORESULT = 0! 

802 12 i:i 53 PROMPTLlNE:=» COPY*; PROMPT; 

803 12 111 69 SPLITBUF? 
80«+ 12 1:1 71 FlNDMARKERS; 

805 12 1:1 73 page:=startpage; 

806 12 i:i 76 GETNEXT; 

807 12 i:i 78 WHILE ( STARTOFFSET>=NOTNULLS) AND NOT DONE DO 

808 12 i:2 86 BEGIN 

809 12 i:3 86 CHKOVFLW; 

810 12 1:3 88 startoffset:=startoffset-notnulls; 

811 12 i:3 93 GETNEXT; 

812 12 i:2 95 END; 

813 12 111 97 IF <ST0PPAGE<PAGE) AND ( STOp0FFSET<N0TNULLS) THEN 
811 12 i:2 06 STUFFlT(STARTOFFSET,MlN(NOTNULLS-liSTOPOFFSET-l) ) 

815 12 i:i 18 ELSE 

816 12 i:2 22 STUFFlT(STARTOFFSET»NOTNULLS-l) ; 



HI H Y'.l 2 Jt WHILE (<STOPPAGE> = PAGE) OR < STOPOFFSET>=NOTNUL L S ) > A N D NOT DONE DO 

J-t J. • d. 4 u BEGIN 

819 12 K3 40 CHKOVFLW; 

820 I 2 153 42 GETNEXT? 

HI \\ \\\ tt IF (STOPPAGE<P A GE) AND (STOPOFFSET<NOTNULLS) THEN 

HI \\ \\\ J 3 STUFFIT(0,MIN(NOTNULLS-1,STOPOFFSET-1)) 

o<-o 12 1:3 65 ELSE 

STUFFIT(O.NOTNULLS-l) 



824 12 1:4 69 

825 12 1:2 73 END; 

8P7 \l \\\ I 7 , 1 I ,f; f . IORE:SULT<>0 THEN ER RORCDISK ERROR, •, NONFATAL); 

°* r i« 1»1 01 UNSPLITBUF; 

fj?f 12 1:1 ° 3 CENTERCURSOR(TRASH, MIDDLE, TRUE); 

829 12 1:1 13 CLOSE(F); 

830 12 1:0 20 END; 

831 12 i:o 46 

832 12 1:0 <f6 (*$I COPYFILE *) 
832 12 1:0 46 (*$I ENVIRON *) 

f, 33 Jf 1:d ! SEGMENT PROCEDURE ENVIRONMENT; 

83h 13 i:d 1 VAR 

835 I 3 1!D 1 i: INTEGER; 

836 13 1ID 2 

837 13 2:D 1 PROCEDURE ERASE10; 

838 13 2:d 1 VAR I: INTEGER; 

839 13 2:0 BEGIN 

2!J J 3 ? !1 ° WRITEC MIO); 

lit J 3 III 8 F 0« i:=l TO 10 DO WRITE(CHR(BS))I 

842 13 2:0 36 END; 

843 13 2:0 50 

!*2 13 3:d 1 procedure bool(b:boolean); 

845 13 3:0 BEGIN 

847 II 111 *2 J F 5 THEN WRITE(.TRUE») ELSE WRITE ( 'FALSE* ) ? 
°**' io 3,1 34 writeln 

848 13 3.-0 34 END; 

849 13 3:0 52 

850 13 4:d 3 FUNCTION GETBOOL: BOOLEAN; 

851 13 4:d 3 VAR CH: CHAR; 

852 13 4:o BEGIN 

853 13 4:i ERASE10; CH:=UCLC (GETCH) ; 

!?£ J 3 ? :i " WHILE NOT (CH IN C'T'.'F']) DO 

855 13 4.-2 35 BEGIN 

856 13 4:3 35 WRITEMT OR F f >; 



143 



141 

857 13 4:3 51 FOR TRASH:=0 TO 5 DO WRITE( CHR <BS ) ) ! 

858 13 4:3 85 CH:=UCLC(GETCH) 

859 13 4!2 90 EHj; 

860 13 4!1 99 IF Cr|= , T» THEN 

861 13 4:2 04 BEGIN 

862 13 4:3 04 WRITECTRUE •)? 

863 13 4:3 20 GETBOOL:=TRUE 

864 13 4:2 20 END 

865 13 4:i 23 ELSE 

866 13 4:2 25 BEGIN 

867 13 4:3 25 WRITE(»FALSE •>; 

868 13 4:3 41 GETBOOL:=FALSE 

869 13 412 41 END! 

870 13 410 44 END? 

871 13 4:o 60 

872 13 5:D 3 FUNCTION GETINT: INTEGER? 

873 13 5:D 3 VAR 

874 13 SID 3 CHICHAR5 

875 13 52D 4 N: INTEGER? 

876 13 510 BEGIN 

877 13 5S1 ERASE10; 

878 13 5:i 2 N:=0; 

879 13 5:i 5 REPEAT 

880 13 5:2 5 REPEAT 

881 13 5:3 5 ch:=getch; 

882 13 5:3 12 if NOT (CH IN C • • . . • 9» f CHR< SP) ♦CHR(CR) 3) 

883 13 5:3 31 THEN WRITE( •#• tCHR (BELL) tCHRtBS) ) ? 

884 13 522 60 UNTIL CH IN C *0 • • . , 9» tCHR(SP) ♦CHR(CR) 3? 

885 13 5:2 81 IF CH IN C'0',,'9'] THEN 

886 13 5;3 96 BEGIN 

887 13 5:4 96 WRITE(CH)? 

888 13 5:4 04 IF N<1000 THEN N:=N*10+ORD<CH)-ORD< ♦ • ) 

889 13 5:3 17 END? 

890 13 5:i 20 UNTIL CH IN CCHR(SP) «CHR (CR) D? 

891 13 5;i 29 GETlNT:=N? WRITE{* ») 

892 13 5;0 44 END? 

893 13 5:0 60 

894 13 1:0 BEGIN 

895 13 in WITH PAGEZERO DO 

896 13 i:2 BEGIN 

897 13 1:3 CLEARSCREEN? 
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promptline:= • environment: coptionsd <etx> or <sp> to leave* 
prompt! neeoprompt:=true; llavl 

WRITELN; 



A(UTO IMDENT 
FULLING 
L(EFT MARGIN 
RCIGHT MARGIN 
P(ARA MARGIN 
C(OMMAND CH 
T(OKEN DEF 



•,BUFCOUNT,» BYTES USED, • , BUFSIZE-BUFCOUNT+1 , • AVAILABLE.*) 



OR TDEFINED THEN 



WRITE( 

WRITE( 

WRITE* 

WRITE( 

WRlTEt 

WRITE( 

WRITE( 

WRITELN; 

WRITELN( • 

writeln; 
if sdefined 

BEGIN 

WRITELNC patterns:*); 

IF TDEFINED THEN WRlTEC 
IF SDEFINED THEN WRlTEC, 

writeln; writeln; 
end; 

if count>0 then writeln(» 

WRITE! • •); 

FOR l:=0 TO COUNT-l DO 

BEGIN WRITE(t ' :6 ,NAMECI D) ; 
IF (1+4) MOD 3=0 THEN BEGIN 

END; 

WRITELN; 

writeln; 

WRITELNC DATE CREATED: 



BOOL(AUTOINDENT) ; 
BOOL(FILLING) ; 
WRITELN (LMARGIN) ; 
WRITELN(RMARGIN) ; 
WRITELN(PARAMARGIN) f 
WRITELN(RUNOFFCH) 5 
BOOL(TOKDEF) J 



<SUBST>= 



markers: m 



<target>= • • • ,target:tlength, »♦ »• ) ; 



» t f 



«SUBSTRING;SLENGTH. 



f * 1 1 



); 



WRITELN; WRITE(» *) END 



••CREATED. MONTH, •-♦, CREATED. DAY,'-', 
CREATED. YEAR,' LAST USED? ', 

LASTUSED. MONTH, •-• ,LASTUSED. DAY, ♦-• . 

LASTUSED.YEAR) ; 
GOTOXY(LENGTH(PROMPTLINE) ,0) J 
REPEAT 

ch:=uclc(Getch) ; 

IF NOT (CH IN C'AN'C'FS'L'.'P'.'R'.'T',' • .CHR(ETX) .CHRirRni 
BEGIN ERRORCNOT OPTION' , NONFATAL) ; PROMPT; END 

CASE CH OF 

lr! : ?5r IN ;?°toxy<i8,i); autoindent:=getbool end; 

•F': BEGIN G0T0XY(18,2); FILLING:=GETB00L END; 



THEN 



*£5 



4T •'■«"» 

1 4:0 



939 13 1Z5 97 »L»: BEGIN &0T0XY ( 18 » 3 ) 

940 13 1:5 1 11 »R»: BEGIN G0T0XY(18«4) 

941 13 i:5 1 25 »P«: BEGIN G0T0XY(18,5) 
912 13 lib 1 39 t C i. 3£GIN 60T0XY ( 18*6 ) 

943 13 1:5 1 5b 'T*: BEGIN G0T0XY(18»7) 

944 13 115 1 67 END; 

945 13 1:4 1 16 GOTOXY(LENGTH<^ROMPTLINE),0>; 

946 13 1:3 1 25 UNTIL CH IN C • • 1 CHR ( ETX ) t CHR ( CR ) 3 

947 13 1:3 1 47 REDISPLAY? 

948 13 i:2 1 50 END! 

949 13 i:o 1 50 £NDi 

950 13 i:o 1 72 

951 13 i:o 1 72 

952 13 110 1 72 

953 13 i:o 1 72 (*$I ENVIRON *) 

953 13 1:0 1 72 (*$I PUTSYNTAX *) 

954 14 1ID 1 SEGMENT PROCEDURE PUTSYNTAX; 

955 14 i:D 1 VAR 

956 14 i:D 1 DO. DltD2«BLK»PTR. COLON: INTEGER; 

957 14 i:o 7 T,C:PACKED ARRAY C0«»23 OF CHAR; 

958 14 i:d 11 buf:packed ARRAY CO. .10233 OF char; 

959 14 i:D 23 F! FILE; 

960 14 i:D 63 

961 14 2:D 1 PROCEDURE PUTNUM; 

962 14 2:0 BEGIN 

963 14 2:i MSG:='SYNTAX ERROR #•; PUTMSG; 

964 14 2:i 25 WRITE(USERINFO.ERRNUM«». TYPE <SP>» M 

965 14 2:0 56 END; 

966 14 2:0 68 

967 14 i:o BEGIN (* PUTSYNTAX *) 

968 14 111 WITH USERINFO DO 

969 14 i:2 13 BEGIN 

970 14 i:3 13 OPENOLD(F»'*SYSTEM. SYNTAX*) ; 

971 14 U3 38 IF IORESULTOO THEN PUTNUM 

972 14 1:3 44 ELSE 

973 14 i:4 48 BEGIN 

974 14 1:5 48 IF ERRNUM<=104 THEN BLK:=2 

975 14 i:5 55 ELSE 

976 14 1:6 60 IF ERRNUM<=126 THEN BLK:=4 

977 14 i:6 67 ELSE 

978 14 1:7 72 IF ERRNUM<=151 THEN BLK:=6 



lmargin:=getint end; 
rmargin:=getint end; 
paramargin:=getint end; 
read(runoffch) end; 
tokdef:=getbool end 
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ELSu 

IF ERRNUM<=185 THEN BLK:=6 
ELSE 
IF ERHNUM<=302 THEN BLK:=10 
ELSE BLK:=12; 
IF BL0CKREAD(F,aUF»2.3LK)<>2 THEN PUTNUM 
ELSE 
BEGIN 

IF BUFC0J=CHR(DLE) THEN PTR:=2 ELSE PTR:=0; 

D0J=ERRNUM DIV 100? (* CONVERT ERROR NUMBER TO CHARACTERS *) 

Di:=(ERRNUM-D0*100) DIV 10; 

d2:=errnum mod 10; 

tcod:=chr(do+ordcom); tcid:=chr(di+ord(»om>; 

TC2::=cHR(D2+ORD('0») ) ; 
REPEAT 

fillchar(c.3«»0m! 
colon:=scan(maxchar,=»:»,bufcptR3) ; 
m0veleft(bufcptr],cc3-c0l0n3,c0l0n); 
colon:=colon+ptr; 

PTR:=SCAN(MAXCHAR t =CHR(E0L)»BUFCPTRD)+PTR+3 
UNTIL (T=C) OR <B'JFCPTR3=CHR<0>); 
IF (T<>C) AND (BUFCPTR3=CHR(0>) THEN PUTNUM 
ELSE 

BEGIN 

MOVELEFT(BUFCCOLON+13iMSGC13, (PTR-COLON)-f ) ; 
MSGC0D:=CHR(MIN(68»(PTR-COLON)-4))j (* R- REQUIRED *) 
HOME! CLEARLINE(O); WRlTE(MSGi». TYPE <SP>»M 

END 
END 

end(* if ioresultoo *) ; 
showcursor; 

repeat until getch=' •; 

errblk:=o; errsym:=o; errnum:=o; <* only yell onceim *j 
end(* with userinfo *) 
end(* putsyntax *); 

(*$i putsyntax *) 
(*$i command *) 
segment procedure editcore5 
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(* CORE PROCEDURES. EXECUTE THESE COMMANDS UNTIL EITHER A SET ENVIRONMENT 
COMES ALONG OR A QUIT COMMAND. *) tiMVIKONMENT 



PROCEDURE NEXTCOMMAND! FORWARD! 

PROCEDURE FIXDIRECTION; 
3EGIN 

IF COM*AND=FORWARDC THEN DlRECTION:=»>» ELSE DIRECTI0N:=»<» ; 
HOME; *|RITE<DIRECTI0N); (* UPDATE PROMPT LINE *) 
SHOWCURSOR; NEXTCOMMAND 
END? 

PROCEDURE COPY; 
BEGIN 

promptline:=» copy: b<uffer f<rom file <esc>»$ 
PROMPT; needprompt:=true; 

REPEAT 

ch:=uclc(getch); 
until ch in c , b , t , f , »chr(esc)d; 

IF CH=»B» THEN 
BEGIN 

IF NOT C0PY0K OR ( (BUFCOUNT+COPYLENGTH+10>COPYSTART) 

AND <COPYSTART>=BUFCOUNT>) 
THEN ERROR( 'INVALID COPY. • .NONFATAL) 
ELSE 

IF BUFCOUNT+COPYLENGTH>=BUFSIZE THEN ERRORfNO ROOM' , NONFATAL ) 

BEGIN 

IF COPyLlNE THEN 
BEGIN 

getleading; 
cursor:=linestart 

END; 

IF (C0PYSTART>=CURS0R) AND (COPYSTART<BUFCOUNT) THEN 

MOVELEFT(EBUF-CCOPYSTART+COPYLENGTH3,EBUF-CCURSOR3.COPYLENGTH) 

MOVELEFT(EBUF-CCOPYSTART3,EBUF^CCURSOR3,COPYLENGTH); 

bufcount:=bufcount+copylength; 



1060 13 416 39 READ JUST ( CURSOR , COPYLENGTH ) ; 

1061 15 4:6 46 GCTLEADIN&; 

1062 15 4:6 49 CURSOR • =MAX ( CURSOR t STUFFSTART ) ; 

1063 15 416 58 CENTERCUKS0R<TRASH, MIDDLE. TRUE) 

1064 15 4:5 65 ENDS 

1065 15 4:2 63 END (* CH=«B' *) 

1066 15 4:i 68 ELSE 

1067 15 4:2 70 IF CH='F« THEN EXIT ( EDlTCORE ) ; 
106Q 15 4:i 79 SHOWCURSOR; 

1069 15 4:i 82 NEXTCOMMANO; 

1070 15 410 84 END(*COPY*)5 

1071 15 4:0 02 

1072 15 5:d 1 PROCEDURE DUMP; 

1073 15 5:0 BEGIN 

1074 15 5:1 nextcommand; 

1075 15 5:0 2 END(* DUMP *); 

1076 15 5:0 14 

1077 15 6:D 1 PROCEDURE FIND; FORWARD? 

1078 15 6ID 1 

1079 15 7:D 1 PROCEDURE INSERTIT; FORWARD; 

1080 15 7:d 1 

1081 15 8:d 1 PROCEDURE JUMP; 

1082 15 8:d 1 VAR CHI CHAR; 

1083 15 8JD 2 

1084 15 9:d 1 PROCEDURE JUMPMARKER; 

1085 15 9:D 1 VAR 

1086 15 9ID 1 I: INTEGER; 

1087 15 9:D 2 MNAME: PACKED ARRAY CO. .73 OF CHAR; 

1088 15 9:o BEGIN 

1039 15 9:i WITH PAGEZERO DO 

1090 15 9:2 BEGIN 

1091 15 9:3 GETNAME( »JUMP TO'.MNAME)? 

1092 15 9:3 15 IF MNAME<>» • THEN 

1093 15 9:4 33 BEGIN 

1094 15 9:5 33 i: =0 ; 

1095 15 9:5 36 WHILE (KCOUNT) AND < MNAMEONAMEC I 3) DO I: = I + 1; 

1096 15 9:5 62 IF MNAMEONAMECI3 THEN 

1097 15 916 75 ERRORCNOT THERE. »» NONFATAL) 

1098 15 9:5 89 ELSE 

1099 15 9.'6 94 BEGIN 

1100 15 9:7 94 CURS0R:=P0FFSETCI3! 



14ff 



150 

1101 15 917 03 GETLEADING; 

1102 15 9:7 06 CURSOR:=MAX(CURSOR«STUFFSTART) ; 

1103 15 9:7 15 CENTERCURSORdRASH, MIDDLE, FALSE) 

1104 15 916 22 end; 

1105 15 9:4 25 END; 

1106 15 9:2 25 end; 

1107 15 9:0 25 END; (* JUMPMARKER *) 

1108 15 9:0 10 

1109 15 8:0 BEGIN (* JUMP *) 

1110 15 8:1 PR0MPTLINE:=» JUMP; B(EGINNINS e<nd murker <ESC>»; 

1111 15 8!1 44 PROMPT; 

1112 15 8:i 47 NEEDPROMPT:=TRUE5 (* NEED TO REDISPLAY EDIT: PROMPTLINE! *) 

1113 15 8:1 51 REPEAT 

1114 15 8:2 51 CH:=UCLC(GETCH); 

1115 15 8:2 63 IF CH=»B» THEN 

1116 15 8:3 68 BEGIN 

1117 15 8:4 68 cursor:=i; 

1118 15 8:4 71 getleading; 

1119 15 a:4 74 cursor:=stuffstart; 

1120 15 8:4 77 CENTERCURSOR(TRASH»l»FALSE) 

1121 15 8:3 82 END 

1122 15 8:2 85 ELSE 

1123 15 8:3 87 IF CH='E» THEN 

1124 15 8:4 92 BEGIN 

1125 15 8:5 92 CURSOR:=BUFCOUNT-l! 

1126 15 8:5 97 CENTERCURSORtTRASHiSCREENHEIGHT-liFALSEM 

1127 15 8:4 07 END 

1128 15 8:3 07 ELSE 

1129 15 8:4 09 IF CH=»M» THEN JUMPMARKER 

1130 15 8:4 14 ELSE IF CHOCHR(ESC) THEN ERRWAIT; 

1131 15 8:1 28 UNTIL (CH IN C f B f t »E' t »M» ,CHR (ESC) 3) J 

1132 15 8U 51 NEXTCOMMAND5 

1133 15 8:0 53 END; 

1134 15 8:0 68 

1135 15 10:D 1 PROCEDURE DEFMACRO? 

1136 15 10:0 BEGIN 

1137 15 10:i WITH PAGEZERO DO IF FILLING AND NOT AUTOINDENT THEN 

1138 15 10:3 10 BEGIN 

1139 15 10:4 10 BLANKCRT(l); 

1140 15 10:4 14 THEFlXER(CURSORfREPEATFACTOR.TRUE) ; 

1141 15 10:4 20 CENTERCURSOR(TRASHtMlDDLE.TRUE); 



HJ2 15 10:3 30 END 

I!"" 15 icll % COP?OK"-FA^r r . APPR ° PKlATE ^IKONMENT', NONFATAL, 

l\:i {I JJiJ " SHO«SSiSSV SE ' 

1147 ,? JS :i 71 nextcommand; 

ii!. 7 I' iSSo L 3END! 

Ji » iilS i EbW SETMARKER; 

U53 15 ii 1 :? I I'SLOTj INTEGER; 

115^ is n:*o o begin ME: PACKED ARRAy C0 " 73 of char ' 

use 15 IV-l I needprompt:=true; 

U59 15 if. 3 ,J COUNT:=MIN(10 fC OUNT,; 

1160 is ii ; 23 IF ^ G °r =1 ° THEN 

1161 15 11"=, ox BEGIN 



1163 15 11-6 II F0R I:=0 To COUNT-1 DO 

us* is 11:5 89 y.J?fIEt!l!. ( J: , i.VN A « EC "> 

33 
43 
53 

1169 15 uiJ 73 SLOT:=ORD(CH)-ORD(»0M 



ii, 6 .' II \]\\ » S^S' »«" ONE TO REPLACE,. , 

1167 15 11:5 53 «NTERCURSOR(TRASH.MIOOL£:,TRUEIl 

"68 15 11:5 ?! lr»J? T .'S H " C , , '- , 9*3) THEN GOTO II 



1170 15 tV:l 1,1 E JNO 

72 J? ii:J I' SLOT..COUNT, 

1173 is llll 11 SETNAHECSET'.MNAHE)! 

117. ii ii;, 3 it IF B S E<> ' ' THEN 

1175 15 11:5 12 Z ll H 

1176 15 ll'l 07 F0R I:=0 T COUNT-1 DO 

1177 15 1115 tn . IF NAME CI3=MNAME THEN SLOT:=I 
H78 15 11:5 to 2;5EE5LpT3 S =HNAHEl * 



U79 15 11:5 6a poffsetcs lo tj:=cursor; 

1180 15 11:4 78 

1181 15 11:2 83 END 

1182 15 U:i 83 i;e:n d; D 



1180 15 11-4 78 l F SLOT=c OUNT THEN COUNT: =C0UNT+1 

U81 15 1K2 83 ^ 
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■•* r— f-\ 

PROCEDURE SETSTUFF5 
\/AR ch: CHAR; 
BEGIN 

promptline: = » set: environment mjarker <esc>»; 
prompt; needprompt;=true? 

REPEAT 

ch:=uclc(getch) 5 

if ch='e» then exit(editcore) 

ELSE 

if ch=«m» then sltmarker 
else if chochr(esc) then errwait; 
until ch in c'e't'm' 'chr(esc)]; 
showcursor; 
nextcommand; 
end(* setstuff *) j 

procedure verify} 

BEGIN 

CENTERCURSORt TRASH, MIDDLE » TRUE) J 

SHOWCURSOR; 

NEXTCOMMAND 
END (* VERIFY *) ; 

PROCEDURE XMACRO; 
VAR 

SAVEC.l: INTEGER; 

save:packed array co..maxstringd of char; 

BEGIN 

promptline:=» exchange: text c<bs> A CHAR} c<esc> escapes; <etx> acceptsd»; 
PROMPT; needprompt:=true; 
showcursor; 
savec:=cursor; 
i:=o; 
repeat 
ch:=getch; 

IF MAPTOCOMMAND(cH)=LEFT then 
BEGIN 

IF (CURSOR>SAVEC) then 
BEGIN 

i:=i-i; cuksor:=cursor-i; (* decrement both ptrs *) 



1225 Is lilt It EBUF-CCURS0R3:=SAVECI3; (* RESTORE BUFFER *, 

1226 15 I«J;g 55 en JRITE(CHR(8S),EBUF-CCURS0RD.CHR(8S))| 

1227 15 14: 3 55 ENn 

1228 15 14: 2 55 ELSE 

1230 15 "I* sa IF c CH=CHR(EOL) THEN BEGIN ERRWAIT; SHOWCURSOR END 

1231 15 14:4 70 



1232 15 14:*5 91 ^BEgV" ^ C CHR * ETX J ' CHR ( ESC ) 3 , AND ( EBUF^C CURSOR 3 <>CHR ( EOL ) , THEN 

^234 is IV't ia IF N0T (CH IN C ' '••"^J THEN CH: = ">«; 

1235 15 iJ:? M SAVECI3:=EBUF-CCURSOR3; 

1236 is il:i \\ EBUF-CCURSOR3 S =CH| 

1237 15 il't 11 i:=i*n cursor:=cursor+i; 

1238 1S tu^ ,o WRITE(CH) 

l^OQ IS 14.*S 49 £ ND ; 

J"o is i4M 11 rr T * L CH IN CCHR(ETX).CHR(ESC)3, 

1241 is i^o ff IF CH= CHR(ESC) THEN 

1**1 15 i4: 2 69 BEGIN 

liJi is Ja. : f 69 cur S or:=savec; 

12^ is 1^3 If ;OVELEFT(SAVEC03.EBUF-CCURSOR3,I)i 

1245 15 H\l H ^HOWCURSOR; WRITE (SAVE! I ) ; SHOWCURSOR 

ITuZ 11 1* S1 " nextcommand; 

ipul 11 i, :o 01 END ( * XW, A CR0 *>« 

1248 15 1410 16 

lltl 11 1V° * PROCEDURE 2APIT; 

1250 15 15:o BEGIN 

1252 J' IIH s IF B ^S(LASTPAT-CUR S OR>>80 THEN 

Ittl is i^l 3 8 pRomptline:= 

1255 J' lilt 92 ' "^ J pj™ ARE AB ° UT T ° ZAP ^ THAN 80 CHARS, DO YOU WISH TO ZAP? CT/N)., 

i"? is isi? oo needprompt:=true; 

- » IF B^ (GETCH — ™ 

l^n Is i^l 5 13 SHOWCURSOR; 

i26i is IV-t It nextcommand; 

llfj is IV. 5 18 EXIT(ZAPIT) 

1262 15 15:4 22 r N D; 

1263 15 15.-2 22 END? 

1264 15 15:i 22 IF OKT 0D EL ( MIN ( CURSOR , LASTPAT) , MAX ( CURSOR .LASTPAT) , THEN 

153 
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1265 15 15:2 43 BEGIN 

1266 15 15:3 43 COpyLINE : =FALSE ! 

1267 15 1513 47 READJUST ( MIN ( CURSOR , LASTPAT ), -ABS ( CURSOR-LASTPAT )) ; 

1268 15 1513 62 IF cURSOR>LASTPAT THEN 

1269 15 15:4 67 MOVELEFT ( EBUF'CCURSOR : , E3UF~C LASTPAT;],BUFCOUnT-CURSOR ) 

1270 15 15:3 78 ELSE 

1271 15 15:4 80 MOVELEFT(EBUF"CLASTPAT:tEBUF*CCURSORa,BUFCOUNT-LASTPAT); 

1272 15 15:3 91 BUFCOUNT : =BUFCOUNT-ABS < CURSOR-LASTPAT) ; 

1273 15 15:3 99 CURSOR : =LASTPAT ! 

1274 15 15:3 02 CENTERCURSOR < TRASH , MIDDLE , TRUE ) 5 

1275 15 15:2 12 END? 

1276 15 15:i 12 SHOWCURSOR; 

1277 15 15:i 15 NEXTCOMMAND? 

1278 15 is:o 17 end; 

1279 15 15:o 30 

1280 15 1550 30 (*$I COMMAND *) 
1260 15 1510 30 (*$I INSERTIT *) 

1281 15 7:D 1 PROCEDURE INSERTIT; 

1282 15 7:D 1 CONST 

1283 15 7:D 1 FUDGEFACTOR=10; 

1284 15 7:D 1 VAR 

1285 15 7:D 1 THEREST,LEFTPART,SAVEBUFCOUNT: PTRTYPE; 

1286 15 7:D 4 CLEARED, WARNED, OK, NOTEXTYET,EXITPROMPT,FIRSTLlNE: BOOLEAN; 
1267 15 7:D 10 SPACES, LMOVE.X, LINE, EOLDIST.RJUST: INTEGER; 

1288 15 7:D 16 CONTEXT: PACKED ARRAY Z . .MAXSTRINGD OF CHAR; 

1289 15 7:d 80 

1290 15 16:D 1 PROCEDURE SLAMRIGHT; 

1291 15 16:0 1 (* MOVE (SLAM) THE PORTION OF THE EBUF* TO THE RIGHT OF (AND INCLUDING) 

1292 15 16 :d 1 THE CURSOR SO THAT THE LAST NUL IN THE FILE <EBUF~CBUFCOUNT D) IS NOW AT 

1293 15 16!D 1 E3UF*C3UFSIZE:J. THEREST POINTS TO THE BEGINNING OF THE RIGHT- JUSTIFIED 

1294 15 16: D. 1 TEXT. *) 

1295 15 16:0 BEGIN 

1296 15 16:i GETLEADING; 

1297 15 16:i 3 THEREST:=BUFSlZE-(BUFCOUNT-CURSOR) ; 

1298 15 16U 11 lmove:=bufcount-cursor+i; 

1299 15 16:i 19 MOVERlGHTtEBUF^CCURSORD.EBUF^CTHERESTIULMOVE) ; 

1300 15 16:i 32 GETLEADING; (* SET BLANKS *) 

1301 15 16:i 35 IF THEREST-CURSOR<MAXSTRING THEN 

1302 15 16:2 44 BEGIN 

1303 15 16:3 44 ERRORCNO ROOM TO INSERT. •, NONFATAL) ! 

1304 15 16:3 69 SHQWCURSOR; 
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nextcommand; 
exit(insertit) 
end; 
(* optional indentation *) 

EBUF-CTHEREST-23:=CHR(DLE) I E3UF*CTHEREST-1 3: = C HR ( BLANKS+32 ) ; 

PROCEDURE WRAPUP! 

(* GIVEN THE NEW VALUE OF THE CURSOR (ONE PAST THE LAST VALID CHARACTER 
INSERTED INTO THE BUFFER,, PUT BACK TOGETHER THE TWO S " 

T B HE F E^TOR H C £ A N N l^V^ " ° FF ' UPMTE ^ **™ S ° "KPtS REST OF 

var ptr: ptrtype; 
lngth: integer; 

BEGIN 

WITH PAGEZERO DO 

IF NOTEXTYET AND (NOT FIRSTLINE) AND 

((NOT FILLING) OR AUTOINDENT) AND (CHOCHR (ESC ) ) 
THEN (* WE WANT THE BLANKS BEFORE THEREST *) 
BEGIN 

3UFcount:=bufcount+2; 
therest:=therest-2; lmove:=lmove+2; 

CURSOR :=SCAN(-MAXCHAR,=CHR(EOL)iEBUF' k CCURSOR-l3)+CURSOR; 

M0VELEFT(EBUF' S CTHEREST3,EBUF"CCURS0R3»LM0VE); 
READJUST(LEFTPART+l,CURSOR-(LEFTPART+l) ) J 

BUFC0Unt:=BUFC0UNT+CURS0R-(LEFTPART+1)j 
WITH PAGEZERO DO 

IF FILLING AND NOT AUTOINDENT AND <CH=CHR(ETX ) ) THEN 

llD begin thefixer ( cursor, 1, false) ; firstline:=false; findxyu.line) end; 

UPSCREEN(FIRSTLINE,EXlTPROMPT OR (CH=CHR ( ESC ) ) ,LINE) ; "atca.himej END, 
GETLEAoiNG; 

cursor :=max( cursor, stuffstart > ; 
lastpat:=leftpart+i; 

K,rvI?o :=TRUE5 cop tstart:=lastpat; copylength:=cursor-lastpat; 

NtXTCOMMAND 

end; 

function check(value:integer>: boolean; 

( * ^ JE i s THE potential value of the cursor, if it is not in legal 
ranse then check is false, this function also warns the user if 
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4 S/HE IS GETTING TOO CLOSE TO OVERFLOWING THE BUFFER *) 
BEGIN 

check:=tRUe; 

3 IF VALUE<=LEFTPART THEN 
10 BEGIN 

10 ok;=false; check:=false; 

17 errqrcno insertion to back over. 1 f nonfatal); prompt; 

53 gotoxy(x,line) 

62 END 

62 ELSE 

64 IF VALUE>=THEREST-MAXCHAR THEN 

75 BEGIN 

75 IF NOT WARNED THEN 

81 BEGIN 

81 error( 'please finish up the insertion* » nonfatal ) 5 prompt; 

21 g0t0xy(x,line) : 

30 warned:=true 

30 END? 

34 if VALUE>THEREST-FUDGEFACTOR THEN 

4 3 BEGIN 

43 ERROR( 'BUFFER OVERFLOW MM* ^NONFATAL) 5 

69 WRAPUP; 

71 EXIT(INSERTIT) 5 

75 END 

75 END 

75 end; 

88 

1 PROCEDURE SPACEOVER; 

1 <* THIS PROCEDURE HANDLES SPACES AND TABS INSERTED INTO THE BUFFER *) 
BEGIN 

IF CH=CHR(HT) THEN SPACES : =8-X+0RD< ODD ( X > AND 0DD(248)) ELSE SPACES:=15 
27 IF CHECKtCURSOR+SPftCES) THEN 

38 BEGIN 

38 FILLCHAR(E8UF~|:CURS0R:^SPACESi , *)! 

47 cursor:=cursor+spaces 

48 END 
54 END! 
66 

1 PROCEDURE FIXUP? FORWARD; 
1 

1 PROCEDURE ENDLINE! 
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(* FIRST, IF THERE WAS NO TEXT INSERTED ON THE CURRENT LINE, THEN CONVERT 
ALL OF THE SPACES TO BLANK COMPRESSION CODES. THEN INSERT AN <EOL> INTO 
THE 3JFFER FOLLOWED BY THE APPROPRIATE NUMBER OF SPACES FOR THE 
INDENTATION. *) 
BEGIN 

WITH PAGEZERO DO 
BEGIN 

IF NOTEXTYET THEN FIXUP; 

E3JF*CCURS0RD:=CHR(E0L) 5 

IF AUTOINDENT THEN GETLEADING 

ELSE 

IF FILLING THEN 
BEGIN 

GETLEADING; 

IF ESUF^cSTUFFSTART3=CHR(EOL) THEN (* EMPTY LINE *) 

BLANKS:=PARAMARGIN 
ELSE BLANKS:=LMARGIN 
END 
ELSE BLANKS:=0; 
IF CHECK(CURSOR+BLANKS+l) THEN 
BEGIN 

FILLCHAR(EBUF A CCURS0R + 1D, BLANKS, ' • ) ; 
CURSOR :=CURS0R+3LANKS+1 
END? 

notextyet:=true; 

end; 
end; 

procedure backup; 

(* IF THE CH IS A BACKSPACE THEN DECREMENT CURSOR BY 1. IF THIS WOULD 
RESULT IN BACKING OVER AN <EOL> OR A BLANK COMPRESSION CODE, THEN FALL 
INTO THE CODE FOR A <DEL> (ALSO CHANGING THE CH TO <DEL> FOR COMMUNICATION 

to the outer block) *) 
var ptr: ptrtype; 

BEGIN 

IF CH=CHR(DC1) THEN 

BEGIN GETLEADING; IF CHECK( LINESTART) THEN CURSOR:=LINESTART END 
ELSE 

IF <CH=CHR(BS>) AND 

NOT( (EBUF A CCURS0R-2D=CHR(DLE>) OR (EBUF /x CCURSOR-13=CHR( EOL) ) ) THEN 
BEGIN 

1ST 



1 : 53 

1428 15 22:4 46 IF CURS0R<LEFTPART+2 THEN OK:=FALSE ELSE CURSOR: =CURSOR-l ; 

1429 15 22:3 66 END 

1430 15 22:2 66 ELSE 

1431 15 22:3 68 BEGIN (* A <DEL> OR EQUIVALENT *) 

1432 15 22:^ 68 CH:=CHR(DEL) ; (* TELL THE CRT DRIVER THAT THE LINE HAS CHANGED *) 
1^33 15 22!4 73 GETLEADING; 

1434 15 22:i 76 IF CHECK(LINESTART-I) THEN CURSOR : =LINESTART-1 ; 

1435 15 22:4 90 NOTEXTYET:=FALSE; (* THANK YOU SHAWN! *) 

1436 15 2213 94 END 

1437 15 22:0 94 END; 

1438 15 22:0 06 

1439 15 20:D 1 PROCEDURE FIXUP5 

1440 15 20!D 1 (* CONVERT THE INDENTATION SPACES INTO BLANK COMPRESSION CODES, AND MOVE 

1441 15 20:D 1 THE CURRENT LINE AROUND ACCORDINGLY *) 

1442 15 20:0 BEGIN 

1443 15 20:0 (* FIRST COMPRESS THE CURRENT LINE *) 

1444 15 20U EBUF~CCURSOR3:=CHR(EOL) ; (* FOOL GETLEADING *) 

1445 15 20:i 5 GETLEADING; 

1446 15 20:i 8 IF BYTES >= 2 THEN (* OK TO PUT IN <DLE> U AS IT STANDS *) 

1447 15 20:2 13 M0VElEFT(EBUF*CSTUFFSTART3«EBUF a CLINESTART+23.CURS0R-STUFFSTART) 

1448 15 20:i 26 ELSE 

1449 15 20:2 28 IF CHECK ( CURS0R+2-BYTES ) THEN 

1450 15 20:3 39 MOVERlGHT(EBUF^CSTUFFSTART3,EBUF"CSTUFFSTART+2-BYTES3.CURSOR-STUFFSTART) 

1451 15 20:2 54 ELSE BEGIN OK:=FALSE; EXIT(FIXUP) END? 

1452 15 20:i 64 CURS0R:=CURS0R-(BYTES-2) ; 

1453 15 20:i 71 EBUF^CLINESTARTD:=CHR(DLE); E3UF"CLINESTART+13:=CHR(32+BLANKS) ; 

1454 15 20:0 85 END; 

1455 15 20:0 98 

1456 15 23:0 1 PROCEDURE INSERTCH; 

1457 15 23:D 1 (* THIS PROCEDURE INSERTS A SINGLE CHARACTER INTO THE BUFFER. IT ALSO 

1458 15 23:D 1 HANDLES ALL OF THE CONTROL CODES (EOLiBS.DED AND BUFFER OVER- AND 

1459 15 23:D 1 UNDER- FLOW CONDITIONS. INSERTCH IS CALLED BY THE CRT HANDLER *) 

1460 15 2310 BEGIN 

1461 15 23.*1 REPEAT 

1462 15 23:2 OK:=TRUE; (* NO ERRORS THAT INVALIDATE THE CURRENT CHARACTER HAVE OCCURED *) 

1463 15 23:2 4 CH:=GETCH5 

1464 15 23:2 11 IF MAPTOCOMMAND(CH)=LEFT THEN CH:=CHR(BS>; 

1465 15 23:2 26 IF ORD(CH) IN C SP , hT » EOL »BS , DEL i ETX , ESC 1 DC1 2 THEN 

1466 15 23.*3 59 BEGIN 

1467 15 23:3 59 (* <ETX> AND <ESO ARE HANDLED IN THE BODY OF INSERTIT *) 

1468 15 23:4 59 IF QRD(CH) IN CSP.HTD THEN SPACEOVER 
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ELSE 

IF ORD(CH)=ECL THEN ENDLINE 
ELSE 

IF ORD(CH) IN CDC1.BS.OEL3 THEN BACKUP; 

end 

ELSE 

BEGIN (* A CHARACTER TO INSERT! *) 

IF (CH<M.) OR (CH>»-») THEN CH:=«?»; (* NO NON-PRINTING CHARACTERS *) 
IF NOTEXTYET THEN FIXUP; X " ^AKACIERS *) 

IF CHECK(CURSOR+l) AND OK THEN 
3EGIN 

notextyet:=false; 

ebuf a ccursor3:=ch; 

cursor:=cursor+i 

END! 

end; 

UNTIL OK; 

end; 

procedure popdown; 

BEGIN SPUYS C ° NTEXT ' D ° ING AN IMP "-IED SCROLLUP IF NEC. *) 
IF CLEARED THEN ERaSETOEOL (X . LINE) 
ELSE BEGIN CLEARED:=TRUE 5 ERASEOS (X.LINE ) END; 
GOTOXY{RJUST,LINE); 
ERASETOEOL(RJUSTtLlNE) ; 
WRITE(CHR<LF>); 

JrITE(C0^EXtSd?It1; EN ^ EXITPR ° MPT: = TR ^ LZNE:.SCREENHEIGHT-l END; 
^^FIRSTLINE^FALSE; (* SAYS THAT THE WHOLE SCREEN HAS BEEN AFFECTED. *) 

PROCEDURE WRITESP(CH:CHAR;H0WMANY:INTEGER) ; 
BEGIN 

IF X+H0WMANY<=SCREENWIDTH THEN WRITE( CH;HOWMANY) ; 
IF X+HOWMANY>=SCREENWIDTH THEN 
BEGIN 

G0T0XY(SCREENWIDTH,LINE) ; 

IF X+H0WMANY>SCREENWIDTH THEN 

BEGIN WRITE(»!»); GOTOXY ( SCREENWIDTH.LINE) END 

159 



1510 15 25J1 57 X:=MIN(sCREENWIDTH,X+HOWMANY) 

1511 15 2510 64 END; 

1512 15 25!0 84 

1513 15 26:d 1 PROCEDURE CLEANSCREEN! 

1514 15 26:d 1 (* CODE TO. IF POSSIBLE, ONLY ERASE THE LINE, OTHERWISE CLEAR 

1515 15 26:d 1 THE SCREEN. THEN CALL PQPDOWN *) 

1516 15 2610 BEGIN 

1517 15 26:i o firstline:=false; 

1513 15 26:i 4 IF CLEARED THEN 

1519 15 26:2 9 BEGIN 

1520 15 26:3 9 IF X<SCREENWIDTH THEN ERASETOEOL (X ,LINE) 

1521 15 26:2 22 END 

1522 15 26:i 25 ELSE 

1523 15 26:2 27 BEGIN 

1524 15 26:3 27 CLEARED:=TRUE ; ERASEOS ( X , LINE ) 5 

1525 15 26:2 40 END? 

1526 15 26:i 40 LINE :=LINE+1 ; 

1527 15 26:i 48 IF LINE>SCREENHEIGHT THEN 

1528 15 26:2 55 BEGIN 

1529 15 26:3 55 LlNE:=LINE-l 5 

1530 15 26:3 63 WRlTELN; 

1531 15 26:3 69 EXlTPRQMPT: =TRUE 

1532 15 26:2 69 END; 

1533 15 26:i 73 IF EOLDISTOQ THEN POPDOWN 

1534 15 26:o 80 END? 

1535 15 2&:o 94 

1536 15 27:d 1 PROCEDURE POPOV; 

1537 15 27.-D 1 (* WHEN IN FILLING MODE, THIS PROCEDURE IS CALLED WHEN A LINE IS OVERFLOWED 

1538 15 27:d 1 (X >= RIGHTMARGIN ) . THE WORD IS SCANNED OFF AND "POPPED" DOWN TO THE 

1539 15 27:0 1 NEXT LINE. *) 

1540 15 27:D 1 VAR 

1541 15 27:d i wlength: integer; 

1542 15 27:d 2 save,ptr: PTRTYPE; 

1543 15 27:D 4 WORD: PACKED ARRAY C0..MAXSW3 OF CHAR; 

1544 15 27:o BEGIN 

1545 15 27:i IF NOTEXTYET THEN FlXUP; 

1546 15 27:i 7 PTR : =MAX ( SCAN( -MAXCHAR,= ♦ - ♦ ,E3UF A CCURS0R-1 3) , 

1547 15 27,'l 21 SCAN ( -MAXCHAR , = • » , E3UF*CCURS0R-1 3) ) +CURSOR ; 

1548 15 27U 44 WLENGTH : =CURSOR-PTR ; 

1549 15 27:i 49 WITH PAGEZERO DO IF WLENGTH>=RMARGIN-LMARGIN THEN 

1550 15 27:3 60 BEGIN 



1551 


15 


27:<+ 


60 


1552 


15 


27:4 


64 


1553 


15 


27:3 


63 


1554 


lb 


27:i 


68 


1555 


15 


27:1 


81 


1556 


15 


27:1 


94 


1557 


15 


27:1 


07 


1558 


15 


27:1 


18 


1559 


15 


27:1 


29 


1560 


15 


27:i 


34 


1561 


15 


27:i 


39 


1562 


15 


27:1 


46 


1563 


15 


27:3 


51 


1561 


15 


27:i 


51 


1565 


15 


27:<+ 


54 


1566 


15 


27:<+ 


57 


1567 


15 


27:<+ 


60 


1568 


15 


27:3 


60 


1569 


15 


2712 


63 


1570 


15 


27:3 


65 


1571 


15 


27:1 


70 


1572 


15 


27:1 


79 


1573 


15 


27: i 


81 


1571 


15 


27 :i 


85 


1575 


15 


27:1 


04 


1576 


15 


27:1 


12 


1577 


15 


27:0 


12 


1578 


15 


27 :q 


28 


1579 


15 


7:o 





1580 


15 


7:i 





1581 


15 


7:i 


3 


1582 


15 


7:i 


16 


1583 


15 


7:i 


25 


1584 


15 


7:i 


30 


1585 


15 


7:i 


32 


1586 


15 


7:i 


35 


1587 


15 


7:i 


43 


1588 


15 


7:i 


46 


1589 


15 


7:i 


53 


1590 


15 


7:i 


58 


1591 


15 


7:i 


61 



WRlTESP(CHtl) ; 

exit(popov) 
end; 
if ch=»-» then white( •-» ) ; 

G0T0XY(X-WLENGTH+1,L1NE) i 
ERASETOEOUX-WLENGTH + liLlNE) ? 
^10VERIGHT(EBUF-CPTRJ.EBUF-CPTR + 3J,WLENGTH): 
"OVELEFT (E3UF*CPTR + 3 3 i-WORD tWLENGTH)! 

curs0r:=curs0r+3; 
E3uf^cptR3:=chr(eol) ; 
ebuf^cptr+13:=chr(dle) ; 
with pagezero do if autoindent then 

BEGIN 

c2rsOR?=p?r; ; ( * SET BUNKS T ° ™ E IND ^TATION OF THE LINE ABOVE *> 

getleading; 
cursor:=save 

END 
ELSE 

blanks:=l«argin? 
ebuf /s cptr+23:=chr(blanks+32) ; 

CLEANSCREEN? 

x:=blanks; 

GOTOXY(XiLINE) J WRITE( WORD: WLENGTH) ; 

x:=x+wlength; 

notextyet:=false 

end; 

begin (* insert *) 
cleared:=false; 

"hP I 2 T:=SCAN(MAXCHAR '= cHR( EOL),EBUF-CCURSOR3)« 
MOVELEFT(EBUF A CCURSOR3,CONTEXTC03iEOLDlST) ; 

rjust:=screenwidth-eoldist; 

SLAMRlGHT? 

savebufcount:=bufcount; 
promptline:=insertprompt; 

PROMPT; 

exitprompt:=false; needprompt:=true; 

leftpart:=cursor-i; 

notextyet:=false; 

FINDXY(XiLINE); GOTQXY< X, LlN r ) ; 
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1(52 

erasetoeol(x»line) ; 
firstline:=true; 

if eoldistoo then (* a context needs to be displayed *) 
if rjust>x then (* and it will fit on the current line ... *) 

BEGIN 

GOTQXY(RJUST,LlNE>! WRITE< CONTEXT:EOLOIST> ; GOTOXY( X, LINE ) 
END 
ELSE (* AND IT WON'T FIT ON THE CURRENT LINE *) 

BEGIN 

firstline:=false; 

eraseos(x«llne> 5 (* clear the screen *) 

WRITELN! 

if line=screenheight then 

begin line:=screenheight-i; exitprompt:=true end; 
g0t0xy(rjust,line+1) ! writetcontext :e0ldist ) ; gotoxyt x,line) 

END; 
REPEAT 

INSERTCH; 

IF NOT (ORD(CH) IN CEOL»ETX»ESC tDELi DC13) THEN 
BEGIN 

IF TRANSLATECCH3SLEFT THEN 

BEGIN IF X<=SCREENWIDTH THEN WRITE(CHR(BS ) « » ».CHR(BS))J X;=X-1 END 
ELSE 

IF CH=CHR(HT) THEN WRITESPC », SPACES) 
ELSE 

IF PAGEZERO. FILLING AND (X+l>=PAGEZERO.RMARGIN) THEN POPOV 

ELSE WRITESP(CH,1); 
IF NOT PAGEZERO. FILLING AND ( X=SCREENWlDTH-8) AND (CHOCHR(BS)) 

THEN WRITE(CHR(BELL) ) ; 
IF (EOLDISTOO) AND 

(X>=RJUST) AND FIRSTLINE THEN (*RAN INTO CONTEXT *> 
BEGIN 

POPDOWN; 
G0T0XY(X,LINE) 

end; 

END 
ELSE (* CH IN CEoLiETXtESCtDELtDClD *) 
BEGIN 

IF CH=CHR(EOL) THEN 
BEGIN 

cleanscreen; 
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X:=BLANKSi 

GOTOXY<X,LlNE) ; 
END 
ELSE 

IF CH=CHR<DEL) THEN 

BEGIN 

IF LINE<=1 THEN (* RUBBED OUT ALL OF WHAT WAS ON THE SCREEN *) 

3EGI|\] 

bufcount:=cursor+i; 
ebuf"ccursor3:=chr(eol) ; 
centercursor(line»middle»true) ; 
if eoldistoo then popdown? 

IF EXITPROMPT THEN BEGIN PROMPT? EXITPROMPT:=FALSE END 
ELSE 

begin gotoxy<0»line); clearedt=false; 

erasetoeol(0iline)s line:=line-1 end? 
getleading? 

x:=blanks-bytes+cursor-linestart? 

GOTOXY(XiLINE) 
END 
ELSE 

IF CH=CHR(DC1) THEN 
BEGIN 

X:=0? GOTOXY(X»LINE)? ERASETOEOL(XtLINE) 
END? 
END? 

until ch in cchr(etx)»chr(esc)d? 

if ch=chr(esc) then cursor :=leftpart+1 ; 

bufcount:=savebufcount? 

WRAPUP; 
END! 



(*$I INSERTIT *) 
(*$I MOVEIT *) 
PROCEDURE MOVEIT? 
VAR 

SCROLL«ARK,XtLINE,i: INTEGER? 

EXITPROMPT: BOOLEAN! (* PROMPT AFTER LEAVING MOVEIT! *) 
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1673 15 28:d 6 OLDLINE , OLDX : INTEGER; 

1674 15 28SD 8 NEWDIST,DIST: INTEGER; 

1675 15 28:D 10 DOFFSCREEN , ATEND, INREPLACE. INDELETE : BOOLEAN? 

1676 15 28:3 14 PTR , ANCHOR , OLDCURSOR : PTRTYPE; 

1677 15 28:o 17 

1678 15 2910 1 PROCEDURE SCROLLUP< BOTTOMLINE : PTRTYPE ; HOWMANYI INTEGER); 

1679 15 29:0 3 (* 80TT0ML.INE IS THE "LINESTART" OF THE LINE TO BE SCROLLED UP *) 

1680 15 29ID 3 VAR 

1681 15 29:D 3 PTR: PTRTYPE! 

1682 15 29:d 4 I: INTEGER? 

1683 15 29:o BEGIN 

1684 15 29:0 (* DISPLAY THE NEXT LINE ON THE BOTTOM OF THE SCREEN *) 

1685 is 29:1 o i:=o; 

1686 15 29:i 3 PTR: =SCAN( MAXCHAR,=CHR (EOL) . E3UF~CLINElPTRD) +LINE1PTR+1 ? 

1687 15 29:i 24 WHILE (KHOWMANY) AND (PTR<BUFCOUNT) DO 

1688 15 29:2 33 BEGIN 

1689 15 29:3 33 LlNElPTR: =PTR ; PTR;=SCAN( MAXCHAR»=CHR(EOL) ,EBUF~CPTRD)+PTR+1 ; 

1690 15 29:3 54 I:=I+1 

1691 15 29:2 55 ENDS 

1692 is 29:1 61 i:=o; 

1693 15 29:i 64 GOTOXY< o , SCREENHElGHT) ; 

1694 15 29:i 69 REPEAT 

1695 15 29:2 69 I:=I+U 

1696 15 29:2 74 BLANks:=LEADBLANKS(BOTTOMlINE , BYTES ) ; 

1697 15 29:2 84 WRITE(CHR(LF)) J 

1698 15 29:2 92 LINEOUT(BOTTOMLlNEtBYTEStBLANKStSCREENHEIGHT) ; 

1699 15 29:2 00 LINE:=LINE-l; 

1700 15 29:i 08 until (i>=howmany) or (b0tt0hline>=bufc0unt-1 ) ! 

1701 15 29:1 19 exitprompt;=true; 

1702 15 29:0 23 end(* scrollup *); 

1703 15 29:0 40 

1704 15 30:D 1 PROCEDURE CLEAR ( XI »Yl .X2 .Y2 : INTEGER); FORWARD? 

1705 15 30:D 5 

1706 15 3i:D 1 PROCEDURE CENTER; 

1707 15 3i:o BEGIN 

1708 15 3i:i IF INDELETE THEN 

1709 15 31:2 5 BEGIN 

1710 15 3i:3 5 IF LlNE>=SCREENHEIGHT THEN 

1711 15 3i:4 12 BEGIN 

1712 15 3i:5 12 CENTERCURS0R(LINE,2,TRUE); 

1713 15 31:5 20 IF ABS(CURSOR-ANCHOR) > ABS(DIST) THEN CLEAR ( tl .MAX ( X-l , ) tLINE) 



1714 15 31 : 4 i+9 £N o 

1715 15 31:3 51 ELSE 

1716 15 31:4 53 3EGIN 

1717 15 3i:5 53 CENTERCURSOR (LINE , SCREENHEIGHT-l , TRUE ) ; 

1718 15 3115 63 GOTOXY ( X , LINE) ; 

1719 15 3115 72 IF ABS ( CURSOR-ANCHOR ) > ABS(DIST) THEN WRITE ( CHR ( 11 ) ) 

1720 15 3i:<+ 93 END; 

1721 15 31:3 93 DOFFSCREEN : =TRUE 5 

1722 15 3l!2 97 END 

1723 15 3i:i 97 ELSE 

Hit J! I 112 " IF <COMMAND=PARAC) AND ( ( DlRECTION=»<» ) OR (LINE MOD SCREENHEIGHT=OLDLINE ) ) 

1725 15 31:2 15 THEN CENTERCURSOR ( LINE. OLDLINEtTRUE ) 

1726 15 31:2 25 ELSE CENTERCURSOR (LINE. MIDDLE, TRUE) ? 

1727 15 3i:i i+O IF EXITPROMPT AND (COMMANDOQUITC ) THEN 

1728 15 31:2 49 BEGIN 

1729 15 3i;3 49 PROMPT; EXITPROMPT :=FALSE 

1730 15 3i:2 52 END; 

1731 15 31:1 56 oldline:=line; oldx:=x; 

1732 15 3i:o 68 END; 

1733 15 3i:o 80 

1734 15 32ID 1 PROCEDURE UPMOVE? 

1735 15 32ID 1 VAR I.'INTEGER? 

1736 15 32:o BEGIN 

1737 15 32:i i:=l; 

1738 15 3211 3 GETLEADING; 

1739 15 32:i 6 (* FIND THE LINE FIRST *) 

1740 15 3211 6 WHILE ( K=REPEATFACTOR ) AND ( LINESTART>1 ) 00 

1741 15 32:2 15 BEGIN 

1742 15 3213 15 CURS0R:=LINESTART-1 ; (* LAST CHAR OF LINE ABOVE *) 

1743 15 32:3 20 GETLEADING; 

1744 15 32:3 23 line:=line-i ; i:=I+l; 

1745 15 32:2 36 END; 

\l!% \l W.l II ( * IF P ° SSIBLE: SET THE CURSOR AT THE SAME X COORD WE CAME FROM. OTHERWISE, 

V-rll ,1 ll' Z 38 SET IT EITHER TO THE BEGINNING OF THE BUFFER, THE BEGINNING OF TEXT 

1748 15 32.2 38 ON THAT LINE, OR THE END OF THE TEXT ON THAT LINE *) 

1749 15 32:i 38 CURSOR:= 

1750 15 32:i 38 MAXU, (* THE BEGINNING OF THE BUFFER *) 

1751 15 32:i 39 MAX(STUFFSTART, (* THE BEGINNING OF THE TEXT *) 

\L%\ \\ \ 211 *° MIN(X-BLANKS + BYTES+LINESTART, (* SAME COL *) 

Ttru ,k III 1 49 SCAN(MAXCHAR,=CHR(EOL),EBUF^CCURSORD)+CURSOR (* EOL *) 

1' 34 15 32:i 60 ) 

J bo 
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) i 

IF LINE<1 THEN 
EMD(* UPALINE *) : 



center; 



PROCEDURE DOWNMOVE! 
y/AR 

1: integer; 
nexteol: ptrtype; 

BEGIN 

i:=i; 

NEXTEOL : =SCAN(MAXCHAR.=CHR(EOL) tEBUF^C CURSOR 1) +CURSOR; 
WHILE (NEXTEOL<BUFCOUNT-1) AND { K=REPEATFACTOR ) DO 
BEGIN 

cursor:=nexteol+i; 

nexteol: -scan (maxchart=chr(eol) ,ebuf~ccursor:i)+cursorl 

IF nexteol<bufcount THEN 

BEGIN 

line:=line+i; 

i:=i+i; 

if line=screenheight+1 then 

BEGIN 

scrollmark : =cursor ; 
end; 
end; 
end; 
if line>screenheight then 
if <line-screenheight>=screenheight) or (indelete) then 

CENTER 
ELSE 

SCROLLUP( SCROLLMARK, L I NE-SCREENHEIGHT) ; 
GETLEADING; 

(* IF POSSIBLE SET THE CURSOR AT THE SAME X COORD WE CAME FROM. OTHERWISE, 
SET IT EITHER TO THE END OF THE BUFFER* THE BEGINNING OF TEXT 
ON THAT LINE, OR THE END OF THE TEXT ON THAT LINE *) 
CURSOR:=MIN(BUFCOUNT-l, (* END OF THE BUFFER *) 

MAX(STUFFSTART, (* NOT IN THE INDENTATION *) 

MIN(X-BLANKS+BYTES+LINESTART <* WHERE IT WANTS TO BE *) 
, SCAN (MAXCHAR,=CHR(EOL)»EBUF A C CURSOR 3 )+CURSOR 
) 
) 
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DO 



) ; 

END(* DOmiNMOVE *) » 

PROCEDURE LEFTMOVE; 
3EGIN 

GETLEADING; (* SET UNESTART AND STUFFSTART *) 
WH BEGli STUFFSTART>CURS0R " REPEATFACT0R) AND <CURSOR>REPEATFACTOR> 

IF P rBu"^r^ <* C HARS MOVED OVER *) 

IF EBUF^CCURSOR3=CHR(EOL) THEN CURSOR :=CURSOR-l ; 

, C yS5?! 1 ! ;!;;\ ( ? CAN< " MAXCHARfSCHRCEOL >»EBUF*CCURSOR3) + CURSOR,l)l 

Ll|\lt«— LIlMc-lt 

GETLEADING; (* RESET LlNESTART AND STUFFSTART *) 

END? 

CURSOR:=MAX(STUFFSTART,MAX(CURS0R-REPEATFACTOR.l) ) : 
IF LINE<1 THEN CENTER? 

FINDXY(X»LINE)J 

END (* LEFTMOVE *M 

PROCEDURE RIGHTMOVE; 
VAR 

EOLPTR; PTRTYPE? 
BEGIN 

EOLPTR :=SCAN(MAXCHAR»=CHR(EOL)»EBUF^CCURSOR1)+CURSOR 1 
WHlLE^EOLPTR^URSOR^REPEATFACTORrAND (EO^TRcKuNT-1, 

repeatfactor:=repeatfactor-(eolptr-cursor+i)? 

rr!, S ?!;T E ! LPTR + 1} ( * BEGI ^ING OF THE LINE BELOW *) 
GETLEADING? 

cursor:=stuffstart; 
line:=line+i; 

IF LINE=SCREENHEIGHT+1 THEN SCROLLMARK:=LlNESTART; 
e . n E0LPTR:=SCAN(MAXCHAR,=CHR(E0L),EBUF-CCURS0R3)+CURS0R 
if LINE>SCREENHEIGHT then 



DO 



IF <LINE-SCREENHEIGHT>=SCREENHEIGHT) 

CENTER 
ELSE 

SCROLLUP(SCROLLMARK,LINE-SCREENHElGHT) ; 

CURS0R:=MIN(BUFC0UNT-1,CURS0R+REPEATFACT0R); 
FINDXY(X«LINE); 



OR (INDELETE) THEN 
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I6S 

1337 15 35:0 42 eND<* RIGHTMQVE *)5 

1838 15 35:0 56 

1839 15 36:D 1 PROCEDURE LINEMOVE (REPEATFACTOR: INTEGER); 

1840 15 36:d 2 VAR I: INTEGER; 

1841 15 36:0 BEGIN 

1842 15 3611 o i:=i; 

1843 15 36U 3 IF DIRECTIONS <• THEN 

1844 15 36:2 8 BEGIN 

1845 15 3613 8 WHILE ( K=REPEATFACTOR ) AND <CURS0R>1) DO 

1846 15 36:4 17 BEGIN 

1847 15 36:5 17 IF EBUF^CCURSOR }=CHR < EOL ) THEN CURSOR:=CURSOR-l? {* NULL LINE CASE *) 

1848 15 36:5 30 CURSOR :=SCAN< -MAXCHAR t=CHR<EOL) iEBUF^CCURSORDJ+CURSOR J <* 1 UP *) 

1849 15 36:5 46 IF CURS0R>=1 THEN BEGIN LINE:=LINE-1 5 i:=I+l END? 

1850 15 36:4 64 END; 

1851 15 36:3 66 CURSOR! =MAX ( 1 , CURSOR) ; (* BACK INTO REALITY *) 

1852 15 36:3 75 ATEND:= <CURSOR=l); 

1853 15 36:3 81 IF LINE<1 THEN CENTER 

1854 15 36:2 88 END 

1855 15 36U 90 ELSE 

1856 15 36:2 92 BEGIN <* DIRECTlON=»>» *> 

1857 15 36:3 92 WHILE ( K=REPEATFACTOR) AND (CURSOR<BUFCOUNT-l ) DO 

1858 15 36:4 03 BEGIN 

1859 15 36:5 03 CURSOR:=SCAN(MAXCHAR«=CHR (EOL) ,EBUF*CCURSOR3> +CURSOR+1 ? (*1D0WN*) 

1860 15 36:5 20 IF CURSOR<BUFCOUNT THEN 

1861 15 36:6 25 BEGIN 

1862 15 36!7 25 i:=I+l? LINE:=LINE+H 

1863 15 36:7 38 IF LINE=SCREENHEIGHT+1 THEN SCROLLMARK:=CURSOR S 

1864 15 36:6 51 END 

1865 15 36:4 51 END? 

1866 15 36:3 53 ATEND:= (CURSOR>=BUFCOUNT-l ) ? 

1867 15 36:3 61 IF LlNE>SCREENHEIGHT THEN 

1868 15 36:4 68 IF <LINE-SCREENHEIGHT>=SCREENHEIGHT) OR (COMMAND=PARAC ) 

1869 15 36:4 78 OR INREPLACE OR INDELETE 

1870 15 36:4 83 THEN 

1871 15 36:5 89 CENTER 

1872 15 36:4 89 ELSE SCROLLUP ( SCROLLMARK.LINE-SCREENHEIGHT) { 

1873 15 36:3 03 CUrsOR:=MIN(CURSOR ,BUFCOUNT-l ) 

1874 15 36:2 07 END? 

1875 15 36:i 14 GETLEADlNG? 

1876 15 36:i 17 CURSOR:rSTUFFSTART ; <* FORCED TO BEGINNING OF STUFF *) 

1877 15 36:i 20 X:=BLANKS? 



1878 15 36:0 HH END(* LlNEMOVE *); 

1879 15 36:0 40 

1880 15 5710 1 PROCEDURE JUMPBEGIN; 

1881 15 3710 BEGIN 

Jan? H IV 1 ° CUR S0R:=15 CENTERCURSOR(TRASH»i, FALSE) 

1883 15 37:o 8 END? 

1884 15 37:0 24 

1885 15 38:D 1 PROCEDURE JUMPEND; 

1886 15 38:o BEGIM 

1888 15 38-J iS N ^ RS0R:=BUFC0UNT -1' CENTERCURSOR(TRASH,SCREENHEIGHT, FALSE) 

1889 15 38.*0 26 

1890 15 39:D 1 PROCEDURE ADJUSTING; 

1891 15 39:D 1 LABEL l; 

1892 15 39:D 1 TYPE 

1894 ^ lllo X M0DES={RE:LATIVE ' l -E:FTJtRlGHTj, CENTER) 5 

1895 15 39!D 1 LLENGTH,TDELTA»i: INTEGER; 

1896 15 39:D 4 SAVEDlR: CHAR; 

1897 15 39!D 5 MODE: MODES? 

1898 15 39ID 6 

Jonn H ?° ;D l PROCEDURE DOIT(DELTA:INTEGER); 

1900 15 tOJD 2 VAR 

i!2J 15 " 0!D 2 EOLDIST: INTEGER? 

^ *l l° n l D n 3 T: PACKED ARRAY CO. .MAXSTRINGD OF CHAR; 

1903 15 4010 BEGIN 

1905 It SSm 5 ?Fb E ? DlNG? ( * SET LIN E:START, STUFFSTART, AND BLANKS *> 

llll ,t uS:J ,? IF BLANKS + DELTA<0 THEN DELTAS-BLANKS? 

1907 15 ll'-l I* IF <EBUF-CLINESTART3=CHR(OLE)) AND <STUFFSTART-LINESTART=2> THEN 

1908 is 4?ii " X:=0 RD (EBUF-CLlNESTART-HD)+DELTA-32 

1909 15 4012 43 BEGIN 

JqJ? it a?!? <l3 IF STUFFSTART- L INESTART>2 THEN 

1912 15 ll\$ 63 EL ^ VE| -EFT (EBUF^STUFFSTART3,EBUF-CLINESTART*23,BUFC0UNT-STUFFSTART) 

1913 15 40*4 65 BE GIN 

^Ht }! !fSi 5 65 IF BUFCOUNT>BUFSIZE-100 THEN 

1915 15 40:6 72 BEGIN 

ill? H IV-l II ERROR(» BUFFER OVERFLOW .NONFATAL) ? 

,q,I J. 7 7 3 * EXIT(ADJUSTING) 

1918 15 40:6 98 END 
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ELSE 

M0VERIGHT(EBUF / "CSTU^FSTART:,EBUF' > CLINESTART + 2:»BUFC0UNT-STUFFSTART) 
END! 
IF LINESTART + 20STUFFSTART THEN 
3EGIN 

readjust (llnestartt li nestart+2-stuffstart) 5 
3Ufcount:=bufcount+linestart+2-stuffstart; 
end; 
ebuf*clinestart3:=chr(dle) ; 
x:=3lanks+oelta5 
end; 
ebuf a clinestart+1]:=chr(x+32) ; 
cursor :=linestart+2; getleading5 

GOTOXY(0»LINE) ; ERaSETOEOL ( t LINE ) 5 (* ERASE THE LINE *) 
LI NEOUT(LINESTART,BYTESt BLANKS t LINE) ; GOTOXY ( X , LINE ) ; 
END(* DOIT *) 5 

3EGIN (* ADJUSTING *) 
WITH PAGEZERO DO 

BEGIN 

savedir:=direction; exitprompt:=falses indelete:=false; lastpat:=cursor; 

inreplace:=true; 

pro^ptline:=adjustprompt; 

prompt; needprompt:=true; 

mode:=relative; 

SHOirtCURSOR; 

findxy(x.line) ; 
tdelta:=o; 
repeat 
ch:=getch; 

command:=maptocommanD(CH) ; 
infinity:=false; 
if command=slashc then 
begin 
repeatfactor:=i; infinity:=true; ch:=getch; command:=translatecch3 

END 
ELSE 

IF COMMANDsDl-GIT THEN REPEATFACTOR: =GETNUM ELSE REPEATFACTOR : =1 ; 
IF COMMAND IN CUP,DOWND THEN 

BEGIN 

IF COMMAND=UP THEN DIRECTION; =•< • ELSE DIRECTION:='>» ; 
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i: = i; 

atend:=false; 

while not atend and ( ( k = repeatfactor ) or infinity) do 

BEGIN 

i : = 1 + 1 ; 

LINEMOVE(l) 5 
IF MCT ATEND THEN 
BEGIN 

IF MODE=RELATIVE THEN DOIT(TDELTA) 
ELSE 
BEGIN 

llength:=scan(maxchar,=chr(eol) febuf^cstuffstart]) 5 
case mode of 

leftj: doitclmargin-blanks) ; 

rightj: doit< <rmargin-llength+u«blanks) ; 

center: 

D0IT(((RMARGIN-LMARGIN+1)-LLENGTH) DIV 2-BLANKS+LMARGIN) 
END (* CASE *) 
END (* ELSE *) 

end; <* if not atend *) 
end (* while ... *) 
end 

ELSE 

IF COMMANDrLEFT THEN 
BEGIN 

DOIT(-REPEATFACTOR) ; TDELTA :=TDELTA-REPEATFACTOR ; MODE : =RELATIVE 
END 
ELSE 

IF COMMAND=RIGHT THEN 

BEGIN 

OOIT(REPEATFACTOR) 5 TDELTA :=TDELTA+REPEATFACTOR ! MODE:=RELATI VE 
END 
ELSE 

IF COMMAND IN CLISTC . REPLACEC ,COPYC3 THEN 
BEGIN 

GETLEADINGS 

LLENGTH:=SCAN(MAXCHAR,=CHR(EOL) tEBUF^C STUFFSTARTD ) S 

IF C0MMAND=LISTC THEN 

BEGIN MODE:=LEFTJ; DOIT(LMARGIN-BLANKS) END 
ELSE 

IF COMMAND=REPLACEC THEN 
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mode:=rightj; 

COMV|AND = COPrc 



D0IT< (RMARGIN- 
*) 



BEGIN 
ELSE (* 
BEGIN 

mode:=center; 

d0it( ( (rmargin-lmargin + d-llength) 

END 



LLENGTH+1) -BLANKS) END 



DIV 2-BLANKS+LMARGIN) 



THEN BEGIN ERRWAIT! SHOWCURSOR END 



END 
ELSE 
IF CHOCHR(ETX) 
i: UNTIL CH=CHR(ETX) ; 

direction:=savedir; 

end; 
end; 

function tabby: integer? 

BEGIN 

IF REPEATFACTOR > THEN 
IF DIRECTION = ♦>• THEN 

TA3BY!=8*(REPEATFACT0R-1)+ 8-X+0RD(0DD(X) AND0DD(248)) 
ELSE 
BEGIN 

IF X=0 THEN TABBY:=REPEATFACT0R*8 

ELSE TABBY:=8*<RE:PEATFACT0R-1)+X-0RD<0DD(X-1) AND 0DD(248)) 

END 

ELSE tabby:=o 

end; 

procedure moving! 

VAR 

SAVEX: INTEGER! 
BEGIN 

indelete:=false; 

inreplace:=false; 

exitpro*!pt:=false; 

IF INFINITY THEN 
BEGIN 

CASE COMMAND OF 

up»left: JUMPBEGIN5 
dom, right: jumpend; 
space.advance.tab: if 
end; 



DlRECTION=»<» THEN JUMPBEGIN ELSE JUMPEND 
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needprompt:=true» 

NExTCOMMAND; 

exit(moveit) 

end; 

FINDXY(x.LINE); 
REPEAT 

oldx;=x; oldline:=line; 
case command of 

left: LEFTMOVE; 

right: rightmove; 

UP? C UP IF ? IRECT10N = , <' THEN LEFTMOVE ELSE RIGHTMOVE; 
DO^n: DOWiMMOVE; 

advance: linemove(repeatfactor) ; 
parac: 

IF REPEATFACTOR>1000 THEN ERRORPTOO MANYN NONFATAL) 

ELSE LINEMOVE(SCREENHEIGHT*REPEATFACTOR)J 
TA3: BEGIN 

IF REPEATFACTOR >= 4096 THEN 

ERROR< 'INTEGER OVERFLOW f NONFATAL) 
ELSE 

BEGIN 

REPEATFACTOR :=TABBY 5 

IF DlRECTION=»<» THEN LEFTMOVE ELSE RIGHTMOVE; 

SAVEX:=X+1; 

WHILE (XOSAVEX) AND (X MOD 8<>0) DO 
BEGIN 

savex:=x; repeatfactor:=i; 

IF DIRECTIONS' THEN RIGHTMOVE ELSE LEFTMOVE 

END 
END 
END 

end; 

IF EXITPROMPT OR ( COMMAND=PARAC) THEN GOTOXY( X.LINE ) 

uLou 

IF LINE=0LDLINE THEN 
BEGIN 

IF X=OLDX+l THEN 

GOTOXY(X.LINE) [KLUDGE FOR HAZELTINE TERMINALS THAT USED DLES3 
ELSE 

IF X=OLDX-i THEN WRITE ( CHR ( BS) ) 
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ELSE GOTOXY(X.LINE) 

END 

ELSE 

IF X=OLUX THEN 
BEGIN 

IF LINE=OLULINE+l THEN WRITE ( CHR(LF) ) 
ELSE IF LINE=0LDLINE-1 THEN CONTROL* UPCURSOR ) 
ELSE GOTOXY(X,LINE) ; 
END 
ELSE 

GOTOXY(XtLlNE) 5 

repeatfactor:=i; 

nextcommand 
until not (command in cup ,down ,left, right, advance, space, tabs) 5 
if exitprompt then prompt; 

SHOWCURSOR; 
END (* MOVING *) 5 

PROCEDURE PUTITBACK(C1»C2: PTRTYPE); 
VAR 

PTR: PTRTYPE5 

INDENT, LOFF: INTEGER? 
BEGIN 

PTR: =Cl • 

WHILE PTR<=C2 DO 
BEGIN 

if ebuf^[:ptr:=chr(eol) then 

BEGIN 

ptr:=ptr+i; writeln; 
indent:=leadblanks(ptr,loff) ; 
if (ptr<c2) and (indent>0) then 

writec •undent); 
ptr:=ptr+loff 

END 
ELSE 

begin write(ebuf a cptr3) ! ptr:=ptr+1 end? 
end; 

end; 

procedure clear(*x1«y1«x2«y2: integer*); 

(* screen co-ordinate (xi, yd is assumed to be before (x2,y2). this 
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PROCEDURE TAKES THESE CO-ORDINATES AND CLEARS (WRITES BLANKS) OVER 

THE SCREEN BETWEEN THEM (INCLUSIVE) *) 
VAR XX, I; INTEGER! 
BEGIN 

GOTOXY(XlfYl) ; 

xx:=xi; 

F i?vVslll lLl 2 ~cL D °r . B€G l" lF I<>0 ™ EN E RASETOEOL(XX,I); XX:=0; WRlTELN END 
IF YK>Y2 THEN FOR 11 = TO X2 DO WRITE(» •) 

ELSE FOR I:=X1 TO X2 DO WRITEC ») 

end; 

PROCEDURE RESOLVESCREEN; 
VAR 

X1.X2»Y1«Y2»SAVE: integer; 
ci,c2: ptrtype; 

BEGIN 

xi:=x; yi:=line; 
x2:=oldxj y2:=oldline; 
if newdist>dist then 
begin ci:=cursor-i; C2:=oldcursor; xi:=xi-i end 

if newoiskdist then 
begin c2:=oldcursor-i; ci:=cursor; x2:=x2-i end 

ELSE 

EXIT(RESOLVESCREEN) ,• 
IF (Y1>Y2) OR ((Y1=Y2) AND (X1>X2)) THEN 

BEGIN 

save:=ci; ci:=c2; C2:=save; 

sa\/e:=yi; yi:=y2; Y2:=save; 

save:=xi; xi:=x2; X2:=save 

end; 

IF ABS(NEWDIST)>ABS(DIST) then 

CLEAR(Xl,YltX2.Y2) 
ELSE 

BEGIN 

G0T0XY(X1,Y1); 
PUTlTBACK(CltC2) 

end; 
gotoxy(x.line) 

end; 
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61 


2181 


15 


45:1 


66 


2182 


15 


4512 


66 


2183 


15 


4512 


70 


2184 


15 


4512 


76 


2185 


15 


4512 


88 


2186 


15 


4512 


95 


2187 


15 


4512 


04 


2188 


15 


45:2 


21 


2189 


15 


45:3 


32 


2190 


15 


15:4 


32 


2191 


15 


45I4 


35 


2192 


15 


4514 


39 


2193 


15 


45:4 


43 


2191 


15 


4514 


56 


2195 


15 


45:4 


60 


2196 


15 


4514 


64 


2197 


15 


45:4 


69 


2198 


15 


45:5 


69 


2199 


15 


45:6 


69 


2200 


15 


4517 


74 


2201 


15 


4516 


74 


2202 


15 


4517 


79 


2203 


15 


4516 


82 


2204 


15 


4515 


04 


2205 


15 


4514 


06 
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PROCEDURE DELETING; 

LABEL 1; 

VAR 

atbol t anchor »save: ptrtype; 
ok,at3qt*nomove: boolean; 
startline: integer? 

BEGIN 

DOFFSCREEN;=FALSE; INDELETE: = TRUE ! INREPLACE: =FALSE ; EXITPROMPT: =FALSE? 

anchor:=cursor; newuist:=o; 

getleading; at30l:=linestarti atbot:=( cursor=stuffstart) j 

promptline:=deleteprompt; 

prompt; needprompt:=true? 

showcursor; 

FINDXY(XiLINE); 

startline:=line; 

REPEAT 

oldcursor:=cursor; 
dist:=newdist; 
oldx;=x; oldline:=line; 
ch:=getch; 

command :=translatecch a; 

if command=digit then repeatfactor:=getnum else repeatfactor:=i; 
if command in creversec..digit»advance»space] then 
begin 
case command of 

left: leftmove; 

right: rightmove; 

space: if direction=»<» then leftmove else rightmove; 

up: upmove; 

down: downmove; 

advance: linemove(repeatfactor); 

REVERSECiFORWARDC: 
BEGIN 

if command=reversec then 
direction:=»<» 

ELSE 

direction:=»>» ; 
gotoxy(0»o); write(direction) j gotoxy (x»line) 

end; 

tab: 



06 BEGIN 



2206 15 4515 

22?3 ^ Hit 50 IF KEPEATFACT0K>^a96 THEN ERROR <• INTEGER OVFLW .NONFATAL) 

22Q9 15 4517 35 ^ EGlN 

22if is IV-l f? REpeatfactor:=tabby; 

2212 15 ll'l7 s£ rMn F DIRECTI0^J=, < ' THEN LEFTMOVE ELSE RIGHTMOVE 



2213 15 45:5 52 
?214 15 45:4 52 



END 
END 
END; 



ll\l \\ IV.? 11 newdist:=cursor-anchor? 

99i 5 1= Hi 90 resolvescreen; 

2217 15 45:3 92 FND 

2218 15 45:2 92 ELSE 

2220 11 IV-l T-r IF < CH <> CHR < E SO> AND (CH<>CHR( ETX) ) THEN 

2221 15 m ?I mm. 3EGIN ERRWA H; GOTOXY(X,LINE) END 
l\\\ \\ a^: 1 19 UNTIL (CH m CCHR(ETX),CHR(ESC)3); 
HI? \\ II 1 32 IF CH=CHR(ETX) THEN 

2223 15 15:2 39 BEGIN 

2225 is S5 ?! GETLEADING; (* INDENTATION FIXUP *) 

2226 ll ll-l uq IF A I? 0T AND <CURSOR=STUFFSTART) THEN 

2227 15 ll'l « TC 3E ^ N CURSOR; =LINESTART; SAVE:=ANCHOR ; ANCHOR:=ATBOL END; 
522fi is us^ *? IF OKTODEHCURSOR, ANCHOR) THEN • » d l umu. 
pop S7 3EGIN 

2230 Js 45-s ftp «EADJUST(MlN(CURSOR,ANCHOR),-ABS(CURSOR-ANCHOR)); 

2231 ^5 till an COPYLINE:=(CURSOR=LINESTART) AND ATBOT; 
iitl ,1 ll, !2 IF ANCHOR<CURSOR THEN 

2233 is 4sJs 06 £ J°VELEF T (EBUF^CURSOR3,EBUF-CANCHOR^BUFCOUNT-CURSOR ) 

2235 is IV't ?! D1 " OVELEF T<EBUF-i:ANCHOR^EBUF-CCURSORa,BUFCOUNT-ANCHOR) ; 

2236 is ll'-t ll BUFCOUNT:=BUFCOUNT-ABS(CURSOR-ANCHOR)! 

2237 7s ll'.l fl CURSOR:=MIN(CURSOR, ANCHOR); 

2238 is 45:** JJ GETLEADING; CURSOR :=MAX<STUFFSTART, CURSOR ) 

2239 15 45*3 48 EL SE 

III? \l IV 50 cursor:=save 

2241 15 4512 50 END 

2242 15 45:i 53 ELSE 

2243 15 45:2 55 BEGIN 

2245 is IV-x fH COpyLINE .' =FALSE 5 COPYOK : = TRUE ! 

?P4A is I J! COPYSTART:=MlN(CURSOR, ANCHOR); 

b 13 HS * 3 73 COPYLENGTH:=ABS(CURSOR-ANCHOR); 

1^7 



2247 


15 


45J3 


60 


2248 


15 


H5.*2 


o3 


2249 


15 


45:1 


63 


225G 


15 


45 :i 


67 


2251 


lb 


4s:i 


99 


2252 


15 


45:1 


03 


2253 


15 


45 :o 


10 


2254 


15 


45:0 


28 


2255 


15 


2a:o 





2256 


15 


23:i 





2257 


15 


2312 


5 


2258 


15 


28:i 


5 


2259 


15 


28:2 


9 


2260 


15 


28:3 


14 


2261 


15 


28:2 


18 


2262 


15 


2s:o 


22 


2263 


15 


28 :o 


34 


2264 


15 


28:o 


34 


2265 


15 


2810 


34 


2266 


15 


28:o 


34 


2266 


15 


28 :o 


34 


2267 


15 


6:d 


1 


2268 


15 


6:d 


1 


2269 


15 


6:d 


1 


2270 


15 


6:d 


4 


2271 


15 


6:d 


10 


2272 


15 


6:d 


12 


2273 


15 


6:d 


13 


2274 


15 


6:o 


14 


2275 


15 


6:d 


15 


2276 


15 


6:d 


16 


2277 


15 


6:o 


44 


2276 


15 


6:q 


46 


2279 


15 


4650 


1 | 


2280 


15 


46 :o 


[ 


2281 


15 


46 :i 





2232 


15 


46:i 


7 


2283 


15 


46:2 


14 


228"+ 


15 


46."3 


14 


2285 


15 


46.'3 


23 


2286 


15 


46.*3 


28 



CURSOR:=ANCHOR; i ' 3 

end; 

i:iNDEt.ETE:=FALSE; 

OK: = (LlNe. = STARTLIf>IE) AND NOT DOFFSCREEfj; 
UPSCREEF-J(OKtMOT OK, LINE) J 

nextcommand; 
end; 

BEGIN 

IF COMMAND=DELETEC THEN 

DELETING 
ELSE 

IF COMMANO=ADJJSTC THEN 

3ESIN adjusting; nextcommand END 

ELSE MOVING! 
END; 



(*$I MOVEIT *) 
(*SI FIND *) 
PROCEDURE FIND; 
VAR 

THERE* FOUND. LASTPATTERN: BOOLEAN! 
NE^PTR^RT^^ INTEGER; 

mode: (literal. token*; 
i: integer! 
delimiter: char; 
Justin: boolean; 

POSSIBLEtPAT: PTYPE! 

useold, verify: boolean; 

PROCEDURE NEXTCHi 
BEGIN 

ch: = getch; 

if ch=chr(esc) then 

BEGIN 

IF NOT JUSTIN THEN REDISPLAY; 

showcursor; nextcommand; 

EXlT(FIND) ; 



2287 lb ^6: 2 32 ENQ. 

1239 JS llll ^ IF (CH =CHR(EOD) AND JUSTIN THEN 

^ dy 15 46:2 41 BEGIN 

"?? " 46:3 4i justin:=false; 

?P^ 11 IV* 45 BLANKCRT(l) 

2292 15 46:2 46 END 

2293 15 4&:i 49 ELSE 

2294 15 46: 2 51 WRIT E <CH); 

2295 15 46:0 59 END; 

2296 15 46.-0 72 

llll \l !*3 :D X pR °CEDURE SKIP; 

2298 15 47:o BEGIN 

2300 " 47.-J J END^^ CH ™ CCHR ( SP) ' CHR (HT > ' CHR < EOL) H DO NEXTcH 

2301 15 47:o 30 

l\l\ \l 1V° l PR0CE DURE OPTIONS; 

2303 15 48:0 BEGIN 

2304 15 48:i REPEAT 

llll \l ll\ Z ° ch:=uclc(Ch>; 

2306 lb 48:2 8 IF CH=*L» THEN 

230°I 15 IVA \\ ELSE"" M0DE:=LlTERAL ' NEXTCH END 

2309 15 48:3 21 IF C H=»V» THEN 

23U 15 IV^Z 33 E Jf IN VERIF ^= TR ^ NEXTCH END 

l\\\ \l I* 1 * 35 ^ C H=*T» THEN 

23i a 8 !! 11 c H :=uc^,r DE:=T0KEN; NEXTCH ™'< 

till It till It s U kIp; N ° T <(CH=,V,) ° R (CH=f ™ ° R «CH..LMM 

«JZ Is' IS!J IS EN ^ <CH=,SM ° R (CH =' S *> T HEN USEOLD:=TRUE, 

2319 15 4810 98 

2M1 IS £jg 3 v2S C ??™ C i 5tc2Ir™ 1 ' ,G * W * R PATTERN! PTrPE ' ^ PLEN6TH! SIEGER,, 

2322 15 49:o BEGIN 

2323 15 49:i SKIP; 

2325 J' llll 3 J IF BEGIr C,A,,,,Z,, ' A,,,,Z,,, °' ,,,9,,CHR,BS,3THEN 

2327 11 IV4 11 ERR R( 'INVALID DELIMITER. • .NONFATAL) » 

13 49.3 56 if N OT JUSTIN THEN REDISPLAYS 



179 



2328 


15 


49:3 


fe5 


2329 


15 


49:3 


6.7 


2330 


15 


49:2 


71 


2331 


15 


49:i 


71 


2332 


15 


49:i 


75 


2333 


15 


49:i 


78 


233<+ 


15 


19:2 


78 


2335 


15 


49:2 


60 


2336 


15 


49:3 


87 


2337 


lb 


49:4 


87 


2338 


15 


49:5 


98 


2339 


15 


4916 


98 


2340 


15 


49:6 


16 


2341 


15 


49:5 


17 


2342 


15 


49:4 


21 


2343 


15 


49:3 


27 


2344 


15 


49:2 


27 


2345 


15 


49:3 


29 


2346 


15 


49:4 


29 


2347 


15 


49:4 


33 


2348 


15 


4913 


34 


2349 


15 


49:i 


38 


2350 


15 


49U 


49 


2351 


15 


49:2 


56 


2352 


15 


49:3 


56 


2353 


15 


49:3 


87 


2354 


15 


49:3 


96 


2355 


15 


49:2 


02 


2356 


15 


49:i 


02 


2357 


15 


49:0 


07 


2358 


15 


49:0 


22 


2359 


15 


5o:d 


3 


2360 


15 


5o:d 


4 


2361 


15 


5o:d 


4 


2362 


15 


50:0 





2363 


15 


50:1 





2364 


15 


50:1 


3 


2365 


15 


so :i 


30 


2366 


15 


50:0 


37 


2367 


15 


50:0 . 


52 


2368 


15 


5i:d 


1 
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nextcommand; 
exit(find) ! 

END! 

delimite*:=ch; 
1 : = o ; 

REPEAT 
NEXTCHi 

IF CH=CHR(BS) THEN 
BEGIN 

IF (PATTERNCl3OCHR(E0L)> AND (I>0) THEN (* D0N»T GO OVERBOARD! *) 
BEGIN 

write! • »»chr(bs))i 
i:=i-i 

END 
ELSE CONTROL(RIGHTCURSOR) ; (* MAKE UP FOR THE <BS> NEXTCH WROTE OUT *) 

END 
ELSE 
BEGIN 

patternci3:=ch; 
i:=i+i 

END; 
UNTIL (CH=DELIMITER) OR < I>=MAXSTRING) ; 
IF I>=MAXCHAR THEN 
BEGIN 

error(*your pattern is too long» 1 nonfatal) j 
if not justin then redisplay? 
nextcommandi exit(find) 
end; 
plengthj=i-15 
07 end (* parsestring *) s 

FUNCTION okcptr: ptrtype): boolean; 

(* COMPARE PAT AGAINST THE BUFFER *) 

var i: integer; 

BEGIN 

WHILE (KPLENGTH) AND (EBUF"C PTR + I 3=PATC 1 3) DO X:=I + 1| 
OK:= IrpLENGTH! 

end; 
1 procedure skipkind3(var cursor: ptrtype); 



2369 

2370 

2371 

2372 

2373 

2371+ 

2375 

2376 

2377 

2378 

2379 

2380 

2381 

2382 

2383 

2384 

2385 

2386 

2387 

2388 

2389 

2390 

2391 

2392 

2393 

2394 

2395 

2396 

2397 

2398 

2399 

2400 

2401 

2402 

2403 

2404 

2405 

2406 

2407 

2408 

2409 



15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 



5i :o 
5i:o 
51 :o 
5i:i 
51:2 
5i : 2 
5i:o 
5i:c 

52:d 
52:d 
52:d 
52:d 
52:d 

52.' 

52:1 
52:1 
52:1 
52:1 
52:1 
52:2 
52:3 
52:4 

5213 
52:4 
52:3 
52:4 
52:5 
52:4 
5213 

52:h 
52:5 
52:5 
52:5 
52:4 
52:2 
52:0 
52:0 

53ID 

53:0 
53:0 
53:0 









19 
31 
44 
58 
1 
1 
1 
1 
2 


3 
7 
17 
32 
40 
40 
49 
67 
71 
77 
85 
85 
88 
92 
94 
94 
10 
30 
45 
51 
53 
70 
1 
1 
1 
1 



BEGIN 

(* SKIP OVER KINDi CHARACTERS IN THE E8UF. UPDATE THE CURSOR 

TO THE FIRST N0N-KINQ3 CHARACTER 
WHILE EBUF^C CURSOR 3 IN C CHK < SP ) , CHR < HT ) , CHR ( DLE > . CHR < EOL ) D 
IF E3UF A CCURSOR3=CHR(DLE) THEN CURSOR : =CURS0R+2 
ELSE CURS0R:=CURS0R+1; 
END; 



DO 



*) 



PROCEDURE SCANBACKWARD? 

LABEL 11 

VAR 

LOC: PTRTYPEi 

CHTHERE: BOOLEAN! 
BEGIN 

chthere:=truej 
there :=false! 

FILLCHAR(PATC0 3,SlzEOF(PAT), f »); 

MOVELEFTC TARGETC START], PATCo:i«PLENGTH>; 
WHILE CHTHERE AND NOT THERE DO 
BEGIN 

It IF PTR>=PLENGTH THEN <* POSSIBLY THERE *> 

LOC : =SCAN ( -PTR » =PATC 3 , EBUF*C PTR 3) 
ELSE 

LOC:=-PTR5 
IF LOC=-PTR THEN (* NOT THERE! *) 
BEGIN 

chthere:=false« there;=false 

END 
ELSE 
BEGIN 

ptr:=ptr+loc; next:=ptr-u 

IF EBUF^CPTR-13=CHR(DLE) THEN BEGIN PTR:=NEXT{ GOTO 1 END? 
IF OK(PTR) THEN THERE:=TRUE ELSE PTR:=NEXT 

END 
END! 
END; 

PROCEDURE SCANFORWARD? 

LABEL i; 

VAR 

maxscan.loc: integer? 



131 



2iio 
2111 

2112 

2113 

2411 

2115 

2116 

2117 

2118 

2119 

2120 

2121 

2122 

2123 

2121 

2125 

2126 

2127 

2128 

2129 

2130 

2131 

2132 

2133 

2131 

2135 

2136 

2137 

2138 

2139 

2110 

2111 

2112 

2113 

2111 

2115 

2116 

2117 

2118 

2119 

2150 



15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 



53:0 
53:o 
53:i 
53:1 
53:1 
53:1 
53:1 

53:2 
53:3 

53:3 

53:1 
53:3 
53:1 
53:3 
53:1 

53:3 

53:1 
53:5 
53:5 
53:5 
53:1 
53:2 
53:0 
53:0 
si:d 
5i:d 
55:d 
55:d 
55:0 
55:1 
55:1 
55:1 
55:1 
55:1 
55:0 
55:0 
56:d 
56:q 

5610 

56:i 
56:i 



3 



a 

3 

7 

17 

32 

40 

<+0 

53 

58 

73 

77 

80 

85 

92 

91 

91 

10 

30 

15 

51 

53 

70 

1 

1 

1 

1 





1 

10 
15 
72 
80 
92 

1 

1 





1 



chthere: boolean; 

BEGIN 

chthere:=true; 
there:=false; 

FILLCHAR(PATC0D«SIZEOF(PAT), , •) ! 
MOVELEFT(TARGETC START :,PATC0 3»PLENGTH) ; 
WHILE CHTHERE AND NOT THERE DO 
BEGIN 

1: maxscan:=ibufcount-plength)-ptr+i; 
if maxscan>0 then (* still stuff to scan *) 
loc : =scan < maxsc an ♦ =patc 3 » ebuf~cptr !1 ) 

ELSE 

loc:=maxscan; (* dummy up »not found* condition 
if loc=maxscan then 
begin chthere:=false; there:=false end 

ELSE 
BEGIN 

ptr:=loc+ptr; next;=ptr+i; 

if ebuf a cptr-13=chr(dle) then begin ptri=next; 

if ok(ptr) then there:=true else ptr:=next 

END 

END! 

end; 

procedure goforit; 






*) 



GOTO 1 ENO; 



NEXTLINE! 
NEXTSTARTt 



CALCULATE THE START AND STOP FOR THE NEXT LINE *) 



PROCEDURE 
(* GIVEN 
BEGIN 

lastpattern:=false; 
start:=nextstart; 

ST0P:=MIN(TLENGTH-1,START+SCAN(TLENGTH-START,=CHR(E0L),TARGETCSTART3) 

if stop=tlength-l then begin stop: =max ( stop, ) ; lastpattern: =true end 
nextstart:=stop+i; 
end; 



PROCEDURE NEXTTOKEN; 

{* GIVEN NEXTSTART, CALCULATE 

BEGIN 

lastpattern:=false; 
start:=nextstart; 



start and stop *) 



2451 

2452 

2453 

2454 

2455 

2456 

2457 

2458 

2459 

2460 

2461 

2462 

2463 

2464 

2465 

2466 

2467 

2468 

2469 

2470 

2471 

2472 

2473 

2474 

2475 

2476 

2477 

2478 

2479 

2480 

2481 

2482 

2483 

2484 

2485 

2486 

2487 

2488 

2489 

2490 

2491 



15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 



Do 

56 

56 

56 

56 

56 

5612 

56!1 

56:i 
56:i 
56:i 
56:i 
56:i 
56:i 

5610 

56:o 

54:0 

54 :i 
54:1 
54: i 
54:2 
54:2 
54:2 
54:2 
54:2 
54:2 
54:3 



54 

54 

54 

54 

54:6 

54:6 

54.'6 

54:6 

54.'6 

54:6 

54:6 

54:7 

54:6 

54:7 



10 

10 

38 

48 

54 

54 

93 

03 

19 

19 

19 

27 

43 

63 

88 

06 





4 

10 

10 

16 

20 

33 

45 

56 

61 

61 

67 

71 

81 

81 

94 

04 

09 

21 

31 

46 

57 

57 

63 



AND (STARKTLENGTH-1) DO 



IF 

end; 



(* SKIP OVER LEADING KIND3 CHARACTERS *) 

WHILE (TARGETCSTART] IN CCHR ( SP ) , CHR ( EOL > » CHR ( HT ) 2 ) 

start:=start+i; 
stcp:=start; 

(* GET THE NEXT TOKEN *) 

WHILE (KINDCTARGETCSTART3:=KINDCTARGETCST0P+1DD) AND (ST0P<TLENGTH-1 ) DO 

stop:=stop+i ; 
stop:=min(stop*tlength-u ; 

(* TO ACCURATELY TEST FOR THE LAST TOKEN. SCAN OFF THE TRAILING KIND3 

nextstart:=stop+u 

WHILE (TARGETCNEXTSTART3 IN CCHR (EOL) , CHR ( SP) , CHR (HT) D) AND 
(NEXTSTART<TLENGTH) DO MEXTSTART: =NEXTSTART+1 ; 
NEXTSTART=TLENGTH THEN BEGIN STOP:=MAX ( STOP, ) 5 LASTPATTERN:=TRUE 



END! 



begin(* goforit *) 
found :=false; 
next:=ptr; 

REPEAT 

ptr:=next; (* SET 
nextstart:=o; (* 



TO next place 

FOOL NEXTLINE 



TO SCAN FOR *) 
INTO GIVING US 



IF MODE=LITERAL THEN NEXTLIME ELSE NEXTTOKEN; 
PLENGTH:=STOP-START+l; 

IF DIRECTI0N=»>» THEN SCANFORWARD ELSE SCANBACKWARD: 
IF THERE THEN 
BEGIN 

couldbe:=ptr? 

found:=true; 

while (not lastpattern) and found do 

BEGIN 

if m0de=literal then 
ptr:=ptr+plength; 

SKIPKIND3(PTR)« (* GO PAST THE JUNK ON THE 
PLENGTH:=ST0P-START+1? (* FOR THE NEW LINE 
FILLCHAR(PATC0 3«SIZEOF(PAT)»» Ml 

MOVELEFT(TARGETCSTART3»PATC0 3,PLENGTH)« 
IF PTR+PLENGTH > BUFCOUNT THEN 

FOUND:=FALSE 
ELSE 

IF NOT OK(PTR) THEN FOUND:=FALSE; 



START AND STOP FOR LINE 1 *) 



NEXTLINE ELSE NEXTTOKEN; 



NEXT 
*) 



LINE *) 



133 



184 



2492 


15 


54, 


55 


77 


2493 


15 


54 


13 


79 


2491 


15 


54 


!3 


79 


2495 


15 


54 


!3 


79 


2496 


15 


54 


12 


79 


2497 


15 


54 


!5 


05 


2498 


15 


5<+, 


'6 


05 


2499 


15 


54! 


.6 


21 


2500 


15 


54! 


'7 


29 


2501 


15 


54! 


8 


56 


2502 


15 


54! 


6 


60 


2503 


15 


54! 


!6 


71 


2504 


15 


54! 


17 


07 


2505 


15 


54! 


!5 


11 


2506 


15 


54! 


:i 


11 


2507 


15 


54! 





21 


2508 


15 


54! 





38 


2509 


15 


57! 


D 


1 


2510 


15 


57! 








2511 


15 


57! 


.1 





2512 


15 


57! 


.1 


20 


2513 


15 


57! 


1 


28 


2514 


15 


57! 


.1 


51 


2515 


15 


57! 


:i 


64 


2516 


15 


57! 


:i 


04 


2517 


15 


57! 


:o 


13 


2518 


15 


57! 


:o 


26 


2519 


15 


58! 


D 


1 


2520 


15 


58! 


!D 


1 


2521 


15 


58! 


:o 





2522 


15 


58! 


!1 





2523 


15 


58 


!2 


6 


2524 


15 


58 


!3 


6 


2525 


15 


58 


13 


19 


2526 


15 


58 


!3 


72 


2527 


15 


58 


13 


82 


2528 


15 


58 


!3 


85 


2529 


15 


58 


!3 


92 


2530 


15 


58 


:<+ 


99 


2531 


15 


58! 


5 


99 


2532 


15 


58! 


5 


11 



THEN 



end; 

end; 
(* in token mode make sure the first and last characters 

OF THE TARGET ARE ON 'TOKEN BOUNDARIES' *) 
IF MOQE=TOKEN THEN IF KINDC PATH 33=ORD ( ' A • ) THEN IF FOUND THEN 
BEGIN 

IF <<C0ULDBE>2) AND (EBUF*CC0ULDBE-2X>CHR (OLE) ) ) OR 
(C0ULDBE<=2) THEN (* WHEW! *) 
IF KlNDCEBUF~i:C0ULDBE33=KINDCEBUF*CC0ULDBE-lD:i THEN 

founo:=false; (* false find... don't count it. *> 
if (ptr+plength<=bufcount-l) and 

(kindcebuf*cptr+plength-133=kindcebuf^cptr+plength3 3) 

found:=false; (* ANOTHER false find *) 

END; 

until found or not there! 
end(* goforit *) ; 

procedure putprompt(left.right:string; repeatfactor:integer; LORTIBOOLEAN) 

BEGIN 

promptline:=left; prompt; 

WRITE( 'C*) J 

IF INFINITY THEN WRITEC/') ELSE WRITE(REPEATFACTOR)? 

writec:: '); 

IF LORT THEN IF MODE=TOKEN THEN WRITE( »L( IT» ) ELSE WRITE ( »T(OK» ) ; 
WRITE(RIGHT) 

end; 

proceoure replaceit; 

LABEL l; 
BEGIN 

IF VERIFY THEN 

BEGIN 

CENTERCURSOR(TRASH.MlDDLE»NOT JUSTIN) * 

PUTPROMPT(» REPLACE' »'<ESC> ABORTS, "R»» REPLACES, •• ,f DOESN"T'« 

repeatfactor-i+2, false) ; 
showcursor; 
ch:=getch; 

IF CH=CHR(ESC) then 
BEGIN 

getleading; cursor : =max(cursor,stuffstart) ; 
nextcommand; exitifind) 



2533 


15 


5814 


17 


2534 


15 


58:3 


17 


2535 


15 


t>8:2 


28 


2536 


15 


58:2 


28 


2537 


15 


5e:i 


28 


2538 


15 


58:2 


37 


2539 


15 


58:3 


54 


254Q 


15 


58:4 


54 


2541 


15 


58:4 


91 


2542 


15 


58.* 4 


03 


2543 


15 


58:3 


09 


2544 


15 


58:2 


09 


2545 


15 


58:3 


11 


2546 


15 


5s:i 


26 


2547 


15 


58.*2 


28 


2548 


15 


58:3 


37 


2549 


15 


58:i 


52 


2550 


15 


58:i 


64 


2551 


15 


5812 


73 


2552 


15 


5e:i 


84 


2553 


15 


58:i 


95 


2554 


15 


58:i 


06 


2555 


15 


5e:i 


10 


2556 


15 


5a:i 


24 


2557 


15 


6:o 





2558 


15 


611 





2559 


15 


6:i 


3 


2560 


15 


&:i 


7 


2561 


15 


&:i 


11 


2562 


15 


6:i 


24 


2563 


15 


6:2 


29 


2564 


15 


6:1 


55 


2565 


15 


6:2 


59 


2566 


15 


6:1 


99 


2567 


15 


6:1 


03 


2568 


15 


6:1 


07 


2569 


15 


6:1 


09 


2570 


15 


6:2 


15 


2571 


15 


6:3 


15 


2572 


15 


6:3 


23 


2573 


15 


6:2 


23 



END J 

if <ch<>»rm and (cho'rm then goto 1; 
end; 
(* replace target with substring *) 

IF SLENGTH>CURSOK-LASTPAT THEN 

IF SLENGTH-(CURSOR-LASTPAT)+BUFCOUNT>BUFSIZE-200 THEN 
BEGIN 

ERR0R( 'BUFFER FULL. ABORTING REPLACE ', NONFATAL) ; 
GETLEADING; CURSOR :=MAX(CURSOR ♦STUFFSTART) ; 

NEXTCOMMAND; EXlT(FIND)? 
END 
ELSE 

M0VERIGHT(EBUF«CCURS0R3,EBUF-CLASTPAT+SLENGTH3.BUFC0UNT-CURS0R) 

uL-ou 

IF SLENGTH<CURSOR-LASTPAT THEN 

MOVELEFT(EBUF^CCURSORD,EBUF-CLASTPAT+SLENGTH3,BUFCOUNT-CURSOR){ 
MO V ELEFT(SUBSTRINGC03,EBUF-CLASTPAT3,SLENGTH); CUKSUR) , 

if slengthocursor-lastpat then 

readjust (lastpat,slength-(cursor-lastpat))| 
bufcount:=bufcount+slength-(cursor-lastpat)j 
cursor :=cursqr +slength-(cursor-lastpat){ 
justin:=false? ' 

i:end; 

BEGIN 

uustin:=true; 

useold:=false; 

verify;=false; 

if pagezero.tokdef then mode:=token else mode:=literal: 

IF COMMANDsFINDC THEN 

^PUTPROMPTC FINO»t» <TARGET> =>• .REPEATFACTOR.TRUE) 

NEEDJR^IlTRSE; UCE,,, ^^ <TARG> <SU8> B> ' » R ^ATFACTOR,TRUE) » 
NEXTCH; SKIP; 
OPTIONS; 

IF NOT USEOLD THEN 
BEGIN 

parsestring(target.tlength) ; 
tdefined:=true 
end; 
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2574 15 6:i 21 IF COMMAND=REPLACEC THEN 

2575 15 6:2 32 BEGIN 

2576 15 613 32 NEXTCH; SKIP; 

2577 15 6:3 36 USEOLD : =FALSE ; 
257a 15 6:3 40 options; 

2579 15 6:3 i+2 IF MOT USEOLD THEN 

2580 15 614 48 BEGIN 

2581 15 6:5 48 PARSESTRING(SUBSTRING,SLENGTH) ; 

2582 15 615 56 SDEFINED:=TRUE 

2583 15 &:4 56 END 

2584 15 6:2 60 END; 

2585 15 6:i 60 HOME; 

2586 15 6:1 63 CLEARLINE < ) ! 

2587 15 6:i 67 IF ( ( CQMMAND=FINDC ) AND TDEFINED) 

2588 15 6!1 74 OR ( (COMMAND=REPLACEC > AND SDEFINED AND TDEFINED) THEN 

2589 15 6:2 88 BEGIN 

2590 15 6:3 88 i:=i; 

2591 15 6:3 91 found:=true; 

2592 15 6:3 94 PTr:=CURSOR; 

2593 15 6:3 97 WHILE ( ( K=REPEATFACTOR ) OR INFINITY) AND FOUND DO 

2594 15 614 08 BEGIN 

2595 15 6:5 08 GOFORIT; (* FIND THE TARGET (HANDLES TOKEN AND LITERAL MODE) *) 

2596 15 6:5 10 i:=l+i; 

2597 15 6:5 15 IF FOUND THEN 

2598 15 6:6 18 BEGIN 

2599 15 6:7 18 CURSOR:=PTR+PLENGTH; LASTPAT:=COULDBE; (*SET UP FOR NEXT TIME*) 

2600 15 6J7 26 IF COMMAND=REPLACEC THEN REPLACEIT; 

2601 15 6:7 33 IF DIRECTION^O THEN PTR:=COULDBE-l ELSE PTR:=CURSOR; 

2602 15 6!6 48 END; 

2603 15 6:4 H8 END? 

2604 15 6:3 50 IF NOT FOUND THEN 

2605 15 6:4 54 if NOT( INFINITY AND (I>2) ) THEN 

2606 15 6:5 64 ERROR( 'PATTERN NOT IN THE FILE' , NONFATAL ) 

2607 15 6:2 91 END 

2608 15 6:1 94 ELSE 

2609 15 6:2 96 ERROR('NO OLD PATTERN. ', NONFATAL) ; 

2610 15 6:i 18 CENTERCURSOR(TRASH,MlODLE«NOT JUSTIN); 

2611 15 6:1 28 GETLEAQING; 

2612 15 6:i 31 CURSOR:=MAX(STUFFSTARTtCURSOR) J 

2613 15 6:i 40 SHOWCURSOR; 

2614 15 611 43 NEXTCOviMANO 



2615 


15 


&:o 


'4 3 


2616 


lb 


6:o 


60 


i6l6 


15 


o . U 


6 (J 


2617 


15 


2:d 


1 


2618 


lb 


2:0 





2619 


lb 


2:1 





2620 


15 


2:2 


5 


2621 


lb 


2:3 


b 


2622 


15 


2:3 


13 


2623 


15 


2:3 


16 


2624 


lb 


2:3 


20 


2625 


15 


2:2 


20 


2626 


15 


2:1 


25 


2627 


15 


2:1 


30 


2628 


15 


2:0 


38 


2629 


15 


2:0 


50 


2630 


15 


59ID 


1 


2631 


15 


59:o 





2632 


15 


59 :i 





2633 


15 


59:1 


4 


2634 


15 


59:2 


9 


2635 


15 


59:1 


18 


2636 


15 


59:2 


20 


2637 


15 


59:1 


37 


2638 


15 


59:1 


40 


2639 


15 


59:1 


50 


2640 


15 


59:1 


54 


2641 


15 


59:1 


58 


2642 


15 


59:1 


62 


2643 


15 


59:1 


66 


2644 


15 


59:1 


70 


2645 


15 


5911 


74 


2646 


15 


59:i 


78 


2647 


15 


59:i 


82 


2648 


15 


59:i 


84 


2649 


15 


59:i 


88 


2650 


15 


59:i 


92 


2651 


15 


59:i 


96 


2652 


15 


5911 


00 


2653 


15 


59:i 


04 


2654 


15 


59:3 


04 



*) 
*) 

NEXTCOMMAND? 



CMADE VARIABLE FOR SCREENS OF SHORT WIDTH. MABD 



end; 

(*$I FIND 
(*$I USER 
PROCEDURE 

BEGIN 

IF NEEQPROMPT then 
BEGIN 

promptline:=comprompt; 

PROMPT; 

needprompt:=false; 
showcursor 
end; 
ch:=getch; 

command:=maptocommand<ch) ; 
end(* nextcommand *) ; 

PROCEDURE COMMANDER; 
BEGIN 

infinity:=false; 
if command=slashc then 
begin Repeatfactor:=i; 

ELSE 

if command=digit then repeatfactor:=getnum 
case command of 
illegal: begin errwait; showcursor; nextcommand 
reversecforwardc: fixdirectioni 
copyc: copy; 

dumpc: dump; 
findc: find; 
insertc: insertit; 
jumpc: jump; 

w?& E f" t S2K«SJ, ! * not rET * DEPEN0S 0N TERAK PAN •• 

ouitc: ? (* exit handled in outer BLOCK *) 
replacec: find; 
setc: setstuff; 
verifyc: verify; 
xecutec* xmacro; 
zapc: zapit; 
equalc: begin 
cursor:=lastpat; 



infinity:=true; nextcommand end 



else repeatfactor:=h 



END; 
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2655 

<i656 

2657 

2658 

2659 

2660 

2661 

2662 

2663 

2664 

2665 

2666 

2667 

2668 

2669 

2670 

2670 

2671 

2672 

2673 

2674 

2675 

2676 

2677 

2678 

2679 

2680 

2681 

2682 

2683 

2684 

2685 

2686 

2687 

2688 

2689 

2690 

2691 

2692 

2b93 

2694 



15 

lb 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 



5913 

59:3 

59:3 

59:3 

59.'2 

59:i 

59:i 

59:0 

59:0 

1:0 

i:i 

l; 



1 








1; 

1: 
1: 
1: 

1! 

12:d 

12:0 

12:1 

12:0 

12:0 

13:0 

13:0 

13:1 

13:0 

13:0 

4:0 

4:d 

<+:o 

4:1 

4:1 

4:1 

4:0 

4:0 

16:d 

16:o 

16:i 

16:2 

16:3 

16:3 



u7 getlEaqing,; 

10 cursor:=max(Cursor,stuffstart) ; 

19 cemtercursor(trash. middle. false) ! 

29 showcursor; nextcommand 

32 END! 

36 AD JUSTC DELETEC. PARAC 1 UP t DOWN t LEFT 1 RIGHT 1 ADVANCE 1 TAB t SPACE! MOVE IT 

36 END (* BIG LONG CASE STATEMENT *); 

04 END (* COMMANDER *) ! 

18 

BEGIN (* EDITCORE *) 

NEXTCOMMANO! 

2 WHILE COMMANDOQUITC DO COMMANDER 
7 END! 

26 

26 

26 (*$I USER *) 

26 (*$I MISC *) 

3 FUNCTION MINI* ( AiB: INTEGER >! INTEGER *); 
BEGIN 

IF A<B THEN MIN:=A ELSE MIN:=B 

10 end; 

26 
3 FUNCTION MAX {*( A«B: INTEGER) I INTEGER* ) ; 
BEGIN 

if a>b then max:=a else max:=3 
10 end; 

26 

3 function getch(*:char*) ; 
3 var gch: char; 

BEGIN 

reao(keyboard.gch) ; 

8 if eolnc keyboard) then gch : =chr ( eol ) ; 
21 getch:=gch; 
24 end; 

36 

1 PROCEDURE CONTROL(*(WHAT: SCREENCOMMAND) *) ; 
BEGIN 

WITH SCREEN DO 

BEGIN 

IF HASPREFIXCWHAT3 THEN WRITE ( PREFIX ) 5 

20 WRITE(CHCWHAT]) 5 
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269S 

2696 

2697 

2693 

2699 

2700 

2701 

2702 

2703 

2704 

2705 

2706 

2707 

2708 

2709 

2710 

2711 

2712 

2713 

271<f 

2715 

2716 

2717 

2718 

2719 

2720 

2721 

2722 

2723 

2724 

2725 

2726 

2727 

2728 

2729 

2730 

2731 

2732 

2733 

2734 

2735 



1 
1 
1 
1 
1 
1 
1 



16:3 
16:2 
i6;o 
i6:o 
if :u 
if :a 
if :i 
i4:o 
if :o 
15:d 

1510 

15:1 

15:0 

15:0 

33:d 

33 :d 

33:d 

33:o 

33 :i 

33:2 

33:3 

33:4 

33:5 

33:5 

33: «» 

33:3 

33:4 

33:3 

33:3 

33:3 

33:4 

33:3 

33:2 

33:0 

33:0 

8:d 
8:d 
8:d 
6:0 
8:1 
8:2 



" E^ RITE<FILLIT,: CS ° THAT ™ E SL0W£R TERMINALS CAN KEEP UP<~M. BERNARD. 

fl END; 

54 

begin"* sCREENHAS( *« wh at: SCREENCOMMAND): BOOLEAN*); 
q s" EENhaS:=scree n.chcwhat:k>chr(0); 

22 

BEGIN I0N HASKEY( * (WHAT: KEYCOMMAND): BOOLEAN*); 

2 * askey := k eybrd.chcwhat:i <> chr (0 ); 

" END ; 

1 EKHT N ,?j;r;i?c"siissix? R kch:ch4r,! «^o maNDi 

5 prefixread: boolean; 
begin 

WITH KEYBRD DO 
BEGIN 

IF B r^M =PRE:FIX, AND (PR ^IX <> CHR(O)) THEN 

OC.GIN 

prefixread:=true; 

READ(KEYBOARDtKCH)} 
END 
ELSE 

pRefixread:=false; 
whatitis:=backspacekey; 

WHILE (WHATITIS <> NOTLEGAL) AND NOT( (CHC WHATITISI-Krm Awn 

urn, }? REFIXREA D=HASPREFlXC W HATITIs5 ) dS ""^^ AND 
WHATITIS:=SUCC(WHATITIS) ; 

mapcrtcommand:=whatitis; 

END; 
69 end; 
8f 

4 F * N Fno°M « APT °COMMAND(* (CH:CHAR): COMMANDS *); 

f iA% F K ^D N ? W KE?c N fe M Y MA T ND E . VECT0R ^ G ° ^^ ™ ^ >™RD «CORD *) 
BEGIN 

1? IF <CH=KEYBRD. PREFIX) AND (CHOCHR(O)) THEN 
x * BEGIN 





If 
If 
17 
2f 
2f 
26 
29 
52 
43 
59 
66 
69 



189 



190 



2736 
2737 
2738 
2739 
2710 
2711 
2712 
2713 
2711 
2715 
2716 
2717 
2718 
2719 
2750 
2751 
2752 
2753 
2751 
2755 
2756 
2757 
2758 
2759 
2760 
2761 
2762 
2763 
2761 
2765 
2766 
2767 
2768 
2769 
2770 
2771 
2772 
2773 
2771 
2775 
2776 



a: 
8; 
s; 

8! 

a; 

8! 

8: 
8; 



8J2 

8:i 

8:2 

&:o 

8:0 

9:d 

9:0 

9:1 

9:0 

9:0 

10:0 

10:0 

10:1 

10:1 

10:1 

10:1 

10:1 

10:0 

10:0 

5:d 

5:d 

5:0 

5:1 

5:2 

5:1 

5:2 

5:3 

5:3 

5:2 

5:0 

5:0 

7:d 

7:d 



11 

19 

27 

oQ 

35 

10 

15 

lb 

66 

66 

68 

71 

90 

3 





31 

16 

1 





6 

11 

17 

20 

30 

12 

1 

1 





7 

8 

12 

12 

11 

16 

18 

30 

1 

2 



kcvd:=mapcrtcoiwmand(Ch) ; 

IF KCMO IN CUPKEY..RIGHTKEYD 
CASE KCMO OF 



THEN 



mapt0c0mman3:=up! 
(*aptocummanq:=down; 

maptocommand:=left; 
maptocommand:=right 



upkey: 
doiaINkey: 
leftkey: 
rightkey 

END 
END 
ELSE 

maptocommand:=translatecchd 
end; 

function uclc<*(ch:chak) :char*) ; (* map lower case to upper case *) 

BEGIN 

IF CH IN C'A'm'Z'] THEN UCLC :=CHR ( ORD(CH) -32) ELSE UCLC:=CH 

end; 

procedure prompt; 

BEGIN 

promptlinecij:=direction; 
savetop:=promptline; 
controhwhome) ; 
clearlinE(o> ; 
write(promptline) 
end; 

procedure clearscreen; 
var i:integer; 
begin 

IF SCREENHAS(CLEARSCN) then 

CONTROL(CLEARSCN) 
ELSE 

BEGIN 

home; 
eraseos(o.o) 

end; 
end; 

procedure clearline(*y:integer*) ; 
var i: integer; 



2777 l 710 BEGIN 

y 71 l ] III ° IF SCREENHAStCLEARLNE) THEN 

27a J J J;* 7 ^CONTROL(CLEARLNE, 

'HI 1 . 2 7: ^ 12 3ESLM 

27^3 1 1 II. i2 GOTOXY(0,Y); 

5 -2 JI ^KASETOEOUO.rn 

-III 1 7:0 21 end; 

*786 1 7:o 34 

till i 1 JZ :D x procedure putmsg; 

^788 1 17 : BEGIN 

2790 J J*!, 1 ° CONTRO L( WHOME>; 

27?J 1 f CLEARLINE(O); 

2792 J : 6 savetop : =msg; 

279* J IV. 1 1H WRITE(MSG); 

2793 1 17:0 24 END; 

2794 1 i 7S0 36 

till J \V' D l PROCEDURE HOME; 

2796 1 ib:o BEGIN 

2798 I IV-l y IF SCREENHAS(WHOME) THEN 

2801 1 1810 17 END; 

2802 1 ie:o 30 

2805 1 3:0 BEGIN 

2807 J l\l 8 ^ SC R ^NHAS(ERASEEOL, THEN CONTROL (ER A SEEOL) 

I™ i l: 2 12 B " IN 

281 ° 1 3l! 2I r[ct: I uS7?S5??? H f I S, HT M T ? EN UNITWRIT E(2.BLANKAREA.SCREENWIDTH-X) 

2811 1 3:3 45 |i?^Y?I .?JJ? <2,BLANKAREA,SCREENWI0TH - X+1 >«- 

pftTf J" *: 2 50 END{ 

«ol3 1 3:o 50 END; 

2814 1 3:0 62 

2816 1 20 !o J P R °^DURE BLANKCRT(* Y : INTEGERS); 



2817 1 20:1 



IF SCREENHAS(ERASEEOS, THEN BEGIN GOTOXY<0,Y>; CONTROLCERASEEOS) END 

191 



.192 



2818 
2819 
2820 
2321 
2822 
2823 
2824 
2825 
2826 
2827 
2828 
2829 
2830 
2831 
2832 
2833 
2834 
2835 
2836 
2837 
2838 
2839 
2810 
2841 
2842 
2843 
2844 
2845 
2846 
2847 
2848 
2849 
2850 
2351 
2852 
2853 
2854 
2855 
2856 
2357 
2858 



1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 



20 

20 

20 

20: 

20: 

20: 

20 

20: 

20 

20 

20: 

20: 

20 

6; 
6; 
6; 
6: 
6: 
6: 
6; 

6! 
6! 

6: 
6; 
6; 

6 



19ZQ 



19; 

19! 

19; 
19; 
19; 
19; 

2: 
2; 
2; 

2' 

2; 
2; 
2; 

2 



15 

17 

22 

d2 

24 

40 

40 

42 

42 

47 

51 

51 

64 

1 

3 





7 

8 

12 

12 

16 

45 

50 

50 

64 

1 





8 

10 

22 

22 

1 





8 

:,3 

14 

:.8 

23 



ELSE 

IF Y=l THEN 
BEGIN 

CLEARSCKEEN; 
idlRlTELN(SAVETOP) 
ENJ 
ELSE 
BEGIN 

GOTOXY(0«Y) 5 

eraseos(o.y); 

end; 
end; 

procedure eraseos(*x,llne*) ; 
var i: integer; 

BEGIN 

IF SCREENHAS(ERASEEOS) THEN 

CONTROL(ERASEEOS) 
ELSE 

BEGIN 

ERASETOEOL(X.LINE) ; 

FOR i:=LINE+l TO SCREENHEIGHT DO BEGIN WRlTELN; CLEARLINE(I) END; 

GOTOXY(X,LINE) ; 
END! 

end; 

procedure errwait; 

BEGIN 

WRITECCHRCBELD) 5 

PROMPT; 

end; 



PROCEDURE ERROR(*S: STRING J HOWBAD: ERRORTYPE*); 
BEGIN 

UNITCLEAR(l) I (* THROW AW^Y ALL CHARACTERS QUEUED Up *) 
IF HOWBAD=FATAL THEN 

BLANKCRT(l) 
ELSE 

BEGIN HOMES CLEARLINE(O) END; 

write: ( 'ERROR: ».S); 



IHI } ?.l 49 if H0W3A0=FATAL THEN 

2361 x 2 :i 53 ELSE 

2362 1 2:2 rj0 3EGlN 

2864 1 2«3 o« ^ IT ^' M PLEASE PRESS <SPACEBAR> TO CONTINUE..,; 

2865 i 2 : 2 16 r w ^ PEAT UNTIL GETCH= ' '< NEEQPROMPT : =TRUE 

*- &t,(i 1 ^:u 20 end; 

2867 1 2:0 34 (*$I wise *) 

2fa67 1 2:0 54 (*$I utI L *, 

2~869 J 2 2 in 5 ^ X e° n N tr LEADBLANKS( * (PTR: PTRT ^< VAR BYTES: INTEGER); INTEGER *>; 

2871° I 'JId 5 ON «Jt-° INTS T ° THL BZGimi ^ °r A LINE 

2873 I 2 2 1 1 |q 5 BY T N ES TI HAS R ?HE R nFF^r Tr^r ° F LEADING BLANKS ™ ™AT LINE. 

2374 1 2i: D 5 V AR E THE ° FFSET INT ° ™ E LINE 0F THE FIR ST NON-BLANK CHARACTER «) 

llll J 'iY\ D 5 OLDPTR: ptrtype; 

pa77 1 oJ. ,D 6 ind ^nt: integer; 

2877 1 2i:o BEGIN 

2879 ] lili ° oloptr := ptr; indent:=o; 

2880 1 2i:*2 22 ""JL^ORDCEBUF-CPTR 3) IN CHT, SP, DLED DO 

2882 J" 21-a !J IF EBUF'CPTR 3=CHR ( OLE ) THEN 

2883 l 21J3 45 ElIe"" PTR!sPTRni lND ^T: = INDENT + ORD(EBUF-CPTR 3) -32 END 
2"5 I till 11 IF s 0RDCEBUF- C PTR3) SS P THEN INDEN T :=INDEN T+ 1 

2887 J 2l\.3 5 71 PTr.-PT^I IN °^T: = ( C INDENT DIV 8> + l>* 8 ; <* KLUDGE FOR COLUMNAR TAB! *, 

2888 1 21:2 12 END; * 

till \ l\W ?6 BYT ES:=PTR-0LDPTR; 

PH9? , .I, 1 .' 1 Q6 LEADBLANKS:=INDENT; 

till J oJ:° 86 E ND <*LEA D BLANKS*,; 

2892 1 21:0 00 

2894 I JJin * PROCEDURE REDISPLAY; 

2895 J ii.:g I <* gSp£xJSfE L OF P °j;EoS^JpicS^25 E ^» 2?I E ™ AT THIS C ° DE IS PARTIALLY A 

«£ J iil? ] cal P l L e5 A o T nly OF fr L o W NE c e U n T ^e U rc S 5r s E o E r :? R REAS0NS 0F SPEED - this pr °cedure is 

2898 1 U:o 1 LINEDlST.EOLDIST,LINE: INTEGER; 
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^94 

ptr: ptrtype; 

t: packed array co,.maxsw: of char; 

BEGIN 

BLANKCRT(l) 5 

LItME:=i; 
ptr:=lineiptr; 

REPEAT 

8lanks:=min{leadblanks(ptr»3ytes) tscreenwidth) ; 
gotoxy(blanks.line) ; 
ptr:=pTr+bytes; 

eoldist:=scan(maxchar,=chr(eod »ebuf~cptr}); 
lineoist:=max(o,min(eoldist,screenwidth-blanks+i>) ; 

MOVELEFT(E3UF rt CPTR3fTC0]iLlMEOlST) 5 

IF E3UF*EPTR+LlNEDIST3OCHR(E0L) THEN (* LINE TRUNCATION *) 
TC?4AX(0.LlNEDIsT-l )}: = •!•; 

write(T:linedist> ; 
ptr:=ptr+eoldist+i? line:=line+i 
until (line>screenheight) or <ptr>=bufcount ) 

end; 

procedure centercursor 

(*var line: integer; linesup: integer; newscreen; boolean*); 

(* figure out if the cursor is still on the screen. if it isi and 
newscreen is false* then no redisplay is done. otherwise an attempt 
is made to position the cursor at line "linesup". line is then updated 
to the actual line the cursor was forced to. *) 

VAR 

mark: integer; 
ptr: ptrtype; 

BEGIN 

if ebuf*ccursor:=chrceol) then ptr:=cursor else ptr:=cursor+i; 

line:=o; 
repeat 

ptr * ~ptr~ 1 * 

ptr:=scan(-maxchar»=chR(Eod ,ebuf*cptrd)+ptr; 

line:=line+i; 

if line=linesup then mark:=ptr; 
until (line>screenheight> or ( ( line1ptr=ptr+1 ) and not newscreen) or (ptr<1) 
if line>screenheight then (* off the screen *) 

begin lineiptr:=mark+i; redisplay; line:=linesup end 

ELSE 
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IF LINL1PTR=PTR+1 THEN 
BEGIN 

IF NEWSCREEN THEN REDISPLAY 
END 
ELSE 
BEGIN 

lineiptr:=i; redisplay 

END; 



19 end; 

34 

1 PROCEDURE FINDXY(*VAR INDENT, LINE: INTEGER*); 
3 \/AR 

3 I, lead: integer; 

5 PTR»EOLPTR: PTRTYPE5 
BEGIN 

" T^^E C LJ G ICAL ^R°^OR T " E ,r REEN " ™ E P ° SITl ° N «RRESPON 0tNG 

line:=i; 
ptr:=lineiptr; 

E0LPTR:=SCAN(MAXCHAR«=CHR(E0L),EBUF-CPTR:>+PTR: 
WHILE EOLPTR<CURS0R DO 

BEGIN 

line:=line+i; ptr:=eolptr+i; <* set up for the next line *> 

EOlPTR:=SCAN(MAXCHAR,=CHR(EOL),EBUF-CPTR3) + PTR 

(* NOW FIND THE INDENTATION ON THAT LINE OF THE CURSOR *) 
LEAD:=LEADBLANKS(PTR.I); v.uk & uk *, 

INDENT:=MIN(SCREENWIDTH,(LEAD-I)+(CURSOR-PTR))j 

79 end; ( * findxy *> ( * (EXTRA SPACES) + (0FFSET INT0 LINE) *> 

94 

1 PROCEDURE SHOWCURSOR; 
1 VAR 

i x,y: integer ; 

BEGIN 

FINDXY<x,Y)? 

6 GOTOXY(X.Y) 

11 END(* SHOWCURSOR *) ; 
24 

3 FUNCTION GETNUM(*:iNTEGER*); 
3 VAR 
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32 
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34 
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44 
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n: integer; 
overflow: boolean; 

BEGIN 

n:=o; 

overflow:=false; 

if not (ch in co'.. '9':) them n:=l 

ELSE 

REPEAT 

IF N > 1000 THEN OVERFLOW : =TRUE 
ELSE 
BEGIN 

n:=n*io+ord(CH)-ord( »o' ) ; 
ch:=getch 

END 
UNTIL (NOT (CH IN C ♦ • . . »9» 3) ) OR OVERFLOW; 
IF OVERFLOW THEN 
BEGIN 

errqr( 'repeatfactor > 10 t 000 » ^nonfatal) ! 
getnum:=o; 

END 
ELSE 

getnum:=n; 
command :=maptocommand(ch) 
end; 



{* TAKES CH AND MAPS IT TO A COMMAND *) 



PROCEDURE GETLEADING; 
BEGIN 

(* sets: 

linestart a pointer to the beginning of the line 

stuffstart a pointer to the beginning of the text on the line 

bytes the number of bytes between linestart and 

stuffstart 
blanks the indentation of the line *) 

linestart:=cursor; 

if ebuf*i:linestarn=chr<eol) then linestart:=llnestart-l ; (* for scan! *) 

linestart :=scan(-maxcharf=chr(eol)tebuf rt clinestartd)+linestart+i; 

blanks :=leadblanks( linestart* bytes) ; 

stuffstart :=l i nestart+bytes 
end (* getleading *) ; 

function oktodel (* ( cursor i anchor : ptrtype) boolean *) ; 
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THEN 

you wish to delete anyway? (y/n)»; 
else oktodel:=false; 



BEGIN 

IF ABS( CURSOR- ANCHOR >>(BUFSIZE-3UFCOUNT>+X0 

BEGIN 

mss: = 
»there is no room to copy the deletion. do 

PUTMSGj 

IF UCLC(GETCH)=«Y» THEN OKTODEL:=TRUE 

end 

ELSE 
BEGIN 

(* COPYLINE IS SET BY THE CALLER *) 

copyok:=true; copylength:=abs(cursor-anchor) 5 
copystart:=bufsize-copylength+i; 

M0VELEFT(EBUF^CMIN (CURSOR, ANCHOR) 3, EBUF^CCOPYSTARTDtCOPYLENGTH); 

END? 
END; 

?*°WR?TE E LINE0UT( * VAR p TR:PTRTYPE; BYTES, BLANKS, LINE: INTEGER*) ; 
VAR 

linedist,eoldist: integer? 

t: packed array c0..maxsw3 of char? 

BEGIN 

G0T0XY(BLANKS,LINE)5 
PTR:=PTR+BYTES? 

EOLDIST:=SCAN(MAXCHAR,=CHR(EOL) ^BUF^CPTRJ) I 
LINEDIST:=MAX(0,MIN(EOLDIST,SCREENWIDTH-BLANKS+1) ) ; 
«OVELEFT(EBUF A CPTR3,TC03,LINEDIST) ? 

IF EBUF-CPTR+LINEDISTK>CHR(EOL) THEN (* LINE TRUNCATION *> 
BEGIN 

linedist:=max(linedist,d ? 
tclinedist-id: = »m? 

END? 

write(t:linedist) ; 
ptr:=ptr+eoldist+i 

END? 

PROCEDURE UPSCREEN(*FIRSTLINE,WH0LESCREEN: BOOLEAN? LINE: INTEGER*)? 

(* ZAP, INSERT AND DELETE CALL THIS PROCEDURE TO UPDATE (POSSIBLY PARTIALLY) 
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54 

67 



THE SCREEN. FIRSTLINE MEANS ONLY THE LINE THAT THE CURSOR IS ON NEED 
BE UPDATED. WHOLESCREEN MEANS THAT EVERYTHING MUST EE UPDATED. IF 
NEITHER OF THESE IS TRUE THEN ONLY THE PART OF THE SCREEN THAT'S AFTER 
THE CJRSOR IS UPDATED *) 



VAR 
PTR 



PTRTYPE; 



THE LINE *) 
THIS LINE *> 



BEGIN (* UPSCREEN *) 
IF FIRSTLINE THEN 
BEGIN 

getleading; 

GOTOXY(OtLINE) ; LRASETOEOL ( . LINE) ; (* CLEAN 
LlNEOUT(LINESTART, BYTES, BLANKS, LINE) (* JUST 
END 
ELSE 

IF WHOLESCREEN THEN 

CENTERCURSORt TRASH, MIDDLE. TRUE) 
ELSE (* ONLY UPDATE THE PART OF THE SCREEN AFTER THE CURSOR *) 
BEGIN 

GOTOXY(OfLlNE) * ERASEOS ( ,LINE) J 

getleading; 
ptr:=linestart5 

REPEAT 

blanks:=min(leadblanks(ptr, bytes) fscreenhidth) ; 
lineout(ptr, bytes, blanks. line); (* writes out the line at ptr *) 
line:=line+i 
until (line>screenheight) or (ptr>=bufcount) 

END? 

end; 

procedure readjust(*cursor:ptrtype; delta: INTEGER*); 



(* 



THEN MOVE 
CURSOR BY 



ALL AFFECTED 
DELTA *) 



MARKERS TO CURSOR. ALSO ADJUST ALL 



IF DELTACO 

MARKERS >= 
VAR 

1: INTEGER; 
BEGIN 

WITH PAGEZERO DO 

FOR i:=0 TO COUNT-1 DO 

IF P0FFSETCI3>=CURS0R THEN POFFSETCI 3:=MAX( POFFSETC I 3+DELTA, CURSOR) ; 
IF <COPYSTART>=CURSOR) AND (COPYSTART<BUFCOUNT) THEN 
COPYSTART:=MAX(COPYSTART+DELTA, CURSOR) ; 
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end; 

procedure thefixer<*pakaptr:ptrtype;rfac: integer ;whole-boolfam*>. 

( * rHrrZ JR o P ° lNJS S0MEWHE * E IN A PARAGRAPH. IF WHO^E is ?rSe THEN THE 

ENTIRE PARAGRAPH IS FILLED, OTHERWISE ONLY THAT DIRECTLY AFTER TH? riimsiw 
IS FILLED. RFAC, WHEN IMPLEMENTED WILL TELL HOW MANY pIrJgrIpJ rn «r 
FILLED. NOTE: A PARAGRAPH IS DEFINED AS LINES OF TEXT Sn^T^n lv ? , r UF 
RUN T H F F \°H T ^ T m IT «"^^ OR A LINE S SSSE/ESs^SSJ^hSXaStK-Is 

VAR 

save»ptr»wptr: integer; 
wlength,x: INTEGER; 
done: boolean; 

BEGIN 

WITH PAGEZERO DO 
BEGIN 

save:=cursor; 

cursor:=paraptr; 

getleadingi 

IF EBUF-CSTUFFSTART3 IN CCHR(EOL) .RUN0FFCH3 THEN EXITtTHEFlXER > • 

BE W G?N E THEN <* SCAN BACKWARDS ™« ^E BEGlNKlNG'orilfpjRAGRAPH *> 
REPEAT 

cursor:=linestart-i; 
getleading 

UNTIL (LINESTART<=1) OR <EBUF*CSTUFFSTART3 IN CRUNOFFCH.rHRf rni 1 -n . 
^K^;"™^ 8 ™ 13 IN CRUNOFFCH,CHR(EOU 3 THEN UN ° FFCH ' CH R( "L)3) 5 

PTR.— CURsOR+1 
ELSE 

ptr:=i; 

X:=PARAMAR6IN; 

END 
ELSE 

BEGIN 

ptr:=linestart; 

IF BLANKS=PARAMARGIN THEN X:=PARAMARGIN ELSE XI=LMARGIN 

end; 

CURSOR.-=BUFSIZE-(BUFCOUNT-PTR)+1; <* SPLIT THE BUFFER *> 

MOVERlGHT(EBUF-CPTR3,EBUF-rcURSORD,BUFCOUNT-PTR){ 
(* NOW DRIBBLE BACK THE (REST OF THE) PARAGRAPH *) 

199 
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(* SENTINEL FOR GETLEADING *) 



DO 
ELSE 



EBUF A CPTR3:=CHR(DLE) ; 
E3jF"CPTR+ia:=CHR(X+32) ; 

ptr:=ptr+2; 

ebuf~ccursor-i:j:=chr(eol) 

oome:=false; 

REPEAT 

WHILE EBUF^C CURSORD IN CCHR ( HT ) . CHR( SP) »CHR ( DLE ) 3 

IF EBUF^CCURSOR:=CHR(DLE) then cursor:=cursor+2 
WPTR:=CURSOR; 
(* SKIP OVER A TOKEN *) 

WHILE NOT (EBUF^CCURSORJ IN CCHRIEOL),' »» , - , D) 
(* SPECIAL CASES FOR ».<SPXSP>" AND "-<SP>" *) 
IF EBUF~CCURS0R3='-' THEN IF EBUF^CCURSOR+1 1~* 
IF (EBUF A CCURS0R-1D=«.«) THEN IF 

(EBUF^CCURSORDz* ») AND <EBUF«CCURS0R+1 D=» 
WLENGTH:=CURS0R-WPTR+1; (* INCLUDING THE DELIMITER *) 
IF (X+WLENGTH>RMARGIN) OR (RMARGIN-LMARGIN+K=WLENGTH) 

BEGIN 

if ebuf a cptr-13=' ' then ptr;=ptr-l; 

ebuf^cptr3:=chr(e0l) 5 ebuf~cptr+i:i:=chr (dle ) ; 

ebuf' s cptr+23:=chr(lmargin+32) ; 

ptr:=ptr+3; 

x:=lmargin 

END; 

cursor:=cursor+i; 

movelefttebuf^cwptr^ebuf^cptr^wlength); 
if ebuf a ccurs0r-13=chr(e0l) then 

BEGIN 

IF EBUF /S CCURSOR]=CHR(0) THEN DONE:=TRUE 
ELSE 
BEGIN 

GETLEADING; 

DONE: = (EBUF^i:sTUFFSTARTD=CHR(EOL)) 

OR (EBUF"CSTUFFSTART3=RUN0FFCH) ; 
<* THE LAST TRANSFER WILL MOVE 

OVER THE <EOL> FOR THE PARAGRAPH *) 
IF NOT DONE THEN 
BEGIN 

ebuf~cptr+wlength-ij:=' »; 

(* if <eol> <sp>i map to one space only *) 

IF EBUF A CCURS0R-23=' • THEN PTR:=pTR-l; 



cursor:=cursor+ 



do cursor:=cursor+i; 
• then cursor:=cursor+i 
• ) then cursor:=cursor+i 



then 



313b 1 31 :y .33 Ffjn 

*1«7 1 31 : 7 33 ENJ 

3138 1 31:5 38 END; 

iitt l 31:t * ia x:=x+wlength; 

<iu? ! i i:H 4i PT«;=PTR+WL£NGTH; 

«9J 1 3i:3 48 UNTIL DONE; 

3192 1 31:3 51 

3193 1 31 : 3 63 

3195 1 IJ. 1 ! S M0VELEFT(EBUF^CURS0R3,EBUF-CPTRD,BUFSl2E-CURS0Rn); 

3196 1 3113 90 



readjuskparapjr. (BUFSIZE-CURSOR+PTR+D-BUFCOUNT) ; 
bufcouimt:=bufsize-cursor+ptr+i; 



3197 1 31J3 00 GETLEADING: 



ebuf"C8Ufcount::=chr(o) 

CURSOR !sMIN(BJFCOUrgT-l« SAVE) ? 



3198 1 3i:3 02 

3199 1 31:2 04 end; 

3200 1 31:0 10 end; 

3201 1 3l:o 30 



CURSOR :=MAX( CURSOR, STUFFSTART) 



tilt J IV.? x proce dure getname<*msg:string; var miname*) 

•3203 1 32:D 44 VAR 



VAR 

3204 1 32:d 44 i: INTEGER; 

3205 1 32:D 45 S: STRING; 

3206 1 32:o BEGIN 

320°8 I 32U 4? REASjsJr^^' "^ CLEARLINE < ° > ' WRITE(MS G ,' WHAT MARKER? M 

^??n \ \IW tl F0R I:=1 T0 LENGTH(S) DO SC I 3! =UCLC ( SC 1 1) ; 

\\\\ \ \\\\ 00 MOVELEFT(SC13,MC03,MIN(8.LENSTH(S))H 

3?13 1 x?.'J It FILLCH AR(MCLENGTH(S)3.MAX(0,8-LENGTH(S)),» •) 

°' 1 ' 1 od.Q 35 END; 

3213 1 32:0 50 

3214 1 32:0 50 

3215 1 32:o 50 (*$I UTIL *) 

3216 1 32: C 50 

f?J! ] y-° ° BEGIN (* SEGMENT PROCEDURE EDITOR *) 

3219 1 ill 2 6 repeJ? LIZE! GETLEADING! C URSOR:=MAX(CURSOR,STUFFSTART); 

322? \ Y'-l \% C ENT E RCURSOR(TRASH»(SCREENHEIGHT DIV 2)+l,TRUE)5 

451 J needprompt:=true; 

\%A 1 Y'.'i V" IF U SERINFO.ERR8LK>0 THEN PUTSYNTAX; 

iii l 1#2 51 repeat 

„„ J , 113 51 HOME? CLEARLINE(O); 

*"? \ 1:3 56 EDITCORE; 

1 l ' 5 59 IF COMHANDsSETc THEN ENVIRONMENT 



201 



'? \ > 



3227 
3226 
3229 
'525Q 
3231 
5232 
3233 



6<+ else if command=copyc them copyfile 

7 ; + UNTIL CO«iMAiMO = QUlTC; 

i}2 UNTIL OUT; 

»9 SYSCOM^.MISCINFO.NOBKEAK := F4LSE (* 28 SEPT 77*) 

96 end; 
22 
BEGIN END. 
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SCREEN ORIENTED EDITOR 
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IIS 

UNIVERSITY OF CALIFORNIA, SAN DIEGO 
LA JOLLA CA 92093 



JULY 8, 1978 



/ \ 

\ VERSION \ 
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\ / 



COPYRIGHT (C) 1978, BY THE REGENTS OF THE UNIVERSITY OF 
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i*$L PRINTER: *) 
( * i S + * ) 

(************************ ************************** ** + ***** + *** # + + # ^ + * ](t , 

* 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

************************* ******************************** )|t ** ]K * + :)t + a t * !([ , |c+ j 

{ *$U-*) 

PROGRAM PASCALSYSTEM; 

CONST 

VIDLEN& = 7J (* NUMBER OF CHARACTERS IN A VOLUME ID *) 
TIDLEN3 = 15; {* NUMBER OF CHARACTERS IN A TITLE ID *) 

TYPE 

VID = STRINGCVIDLENGJ? 

TID = 3TRIMGCTIDLENGJ; 

DATEREc=PACKED RECORD 

MONTH! 0..12; 
DAY: 0..31; 

year: 0..100 

END; 

inforec = recoro 

trash1.tkash2: integer; 

errsym,errblk,errmjm: integer; (* error com for edit *) 

trash3: array cq..2d of integer; 



203 



201 



*+3 J i : - 1 GOTsr.j|,GUTcoot: boolean; 

^ l:j 1 WO <KV'lD,SYMVlDtCODEVID: VID; (* PERM^CUR WORKFILE VOLUMES *) 

"5 C l:J 1 W3=<KTlC-tSYMTlLiC0JETIu: TIj (* PERM&CUR WORKFILE TITLES *) 

to 1:3 1 ■ END <*INF0REC*) ! 

•+7 : i:u i 

*+6 l:D 1 SYSCOtfREC = RECORD 

<+9 j i:c i junk: array co..63 of integer; 

so o i : o i lastmp: integer; 

5i 3 i:o i expansion: array CO..203 of integer; 

52 1:0 1 viisciNf-0: PACKED RECORD 

53 3 1:0 1 NOBREAK,STUPlDiSLQWTERM, 

5 *+ i:D 1 HASXYCBT.HASLCCRTiHAS8510AiHASCLOCK: boolean 

55 HO 1 END; 

56 i:d 1 crttype: integer; 

57 i:d 1 crtctrl: packed record 

58 l:d 1 rlf,ndfs,eraseeol,eraseeos, home, escape: char; 

59 i:d 1 backspace: char; 

60 1:0 1 fillcount: 0..255; 

si i:d 1 expansion: packed array C0..33 of char 

62 i:d 1 end; 

63 i:D 1 CRTINFO: PACKED RECORD 

6<+ llD 1 WIDTH, HEIGHT: INTEGER; 

65 HO 1 RIGHT, LEFT, DOWNiUP: CHAR; 

66 i:d 1 BADCH,CHARDEL, STOP, BREAK, FLUSH, EOF: CHAR; 

67 i:d 1 altmode,linedel: CHAR; 

68 Q i:D 1 EXPANSION: PACKED ARRAY CO. .53 OF CHAR 

69 l:D 1 END 

70 110 1 END (+SYSCOM*); 

71 -j i:d 1 

72 3 1:0 1 v'AR (* 1.4 GLOBALS AS OF oO-JAN-78 *) 

73 l:D 1 SYSCOM; "SYSCO^REC; 

7*4 l:D 2 TRASHY: ARRAY CO. .53 OF INTEGER; 

75 3 i:D 8 USERINFo: INFOREC; 

76 i:D 54 TRASHYY: ARRAY C . . 4 J OF INTEGER; 

7 7 o 1:0 59 syvid,.:kvid: vid; 

78 u 1:j i7 thedate: oaterec; 

79 l.-D l.3 

80 o i:d 68 

81 i:D 63 (*4TEDIT3F< SEGMENT*) 

82 1 i:0 1 SEGMENT PROCEDURE EDITOR; 
33 1 i:D 1 CONST 
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(* UNLESS OTHERWISE NOTED ALL CONSTANTS ARE UPPER BOUMDS 
FR0'-1 ZERO, "^j 

! 1AX6UFsiZE = 32767; 

! 4AXSw = j<+5 (* MAXIMUM ALLOWABLE SCREENWIDTH *) 

MAXSTRl|-jG = 127; 

'riDL E H «c.:i?f i ( . < rB^ t srsc5« U : ) " U " 3ES 0F "««" ER s on a line IN the ebuf ., 

CHA^IN3LiF = 2048; (* FOR FINAL VERSION. WOT USED. *) 
"•1AX0FFSET = 1C23; (* MAXIMUM OFFSET IN A PAGE *) 
.•*1AXPAGlI = 255; (* RIDICULOUS UP°ER BOUND! *) 

(* THE FOLLOWING ASCII CHARACTERS ARE HARD-WIRED IN *) 
BSPCE=35 HT=9J LF=105 E0L=13; JLE=16; SP=32; 
DC1=17; 3ELL=7; RU60UT=1275 CR=13; 

TYPE 

PTRTYPE=0..MAX3UFSI2E; 

BUFRTYPE=PACKED ARRAY CO. .03 OF CHAR! 
3L0CKTYPE=PACKED ARRAY CO. .5113 OF CHAR; 

errortype=<fatal, nonfatal) ; 

TABATTRiBUTE=(NONE,LEFTjUST,RIGHTJUST,DECIMALSTOP): 
OFFSET=o..MAXOFFSET« 

page=o..maxpage; 

NAME=PACKED ARRAY CO. .73 OF CHAR; 

PTYPE=PACKED ARRAY C . . MAXSTRING 3 OF CHAR; 

COMVAND S =( ILLEGAL, ADJUSTC, 5ANISHC COPYC, DELETEC, FINDC, INSERTC, JUMPC. 

t^Uc^T^r ?P TC ' PARAC ' ° UITC ' ^PLACE?' SETc" R IeRIFYc" C 
XECUTEC, ZAPC, REvERSEC, FORWARDC Up, DOWN, LEFT, RIGHT. TAB, 

rTYDr e 0IGIT ' DUMPC ADVANCE, SPACE, EQUALC, SLASHC,! 

CTYPE=(FS,GOHO^E,ETOLOL,ETOEOS,US); 

LEFTRISHT=(LEFTSTACK.RIGHTSTACK) ; 

HEADERS (* PAGE ZERO LAYOUT CHANGED 20-JUN-78 *) 
RECORD CASE BOOLEAN OF 

TRUE: (BUF: PACKLD ARRAYC0..MAXOFFSET3 OF CHAR); 
FALSE: (DEFINED: INTEGER; (* NEW FILE => 0; OLD FILE => 1 *) 
S?«rl : INTEGER; (* THE COUNT OF VALID MARKERS *) 

name: array :o..i93 of packed array C0..73 of char; 

pagen: packed array C0..193 of integer- 205 
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POFF3ET: 


PACKED ARRAY CO 


TABSTOP: 


PACKED ARRAY CO 


AUTOIhJOENT: 


BOOLEAN; (* ENV 


filling: 


BOOLEAN; 


TOKQEF: 


BOOLEAN; 


LMARGIn: 


C.MAXSw; 


rmakgin: 


C.MAXSw; 


paramargin: 


O..MAXSrt; 


runoffch: 


CHAR; 


CREATED: 


DATEREC; 


lastupd: 


DATEREC; 


revision: 


INTEGER; 


filler: 


ARRAY CO. .913 



193 OF OFFSET; 

1273 OF tabattribute; 

ENVIRONMENT STUFF FOLLOWS *) 



INTEGER) 



end; 



var 



CURSOR: 0..MAX3UFSIZE; 
BUFCOUmTI O..MAXBUFSIZE; 

stuffstart: o..maxbufsize; 
linestart: o..maxbufsize; 
bytest3lanks: integer; 
ch: char; 
direction: char; 
REpeaTfactor: integer; 
bufsiz-:: integer; 
screenwidth: integep? 
screenheight: integer; 
command: commands; 
lastpat: 0..max3ufsize; 
ebuf: a bufrtype; 
kind: array cchar3 cf integer! 
lineiptr: o..maxbufsize; 
MIDDLE: integer; 
needprompt: boolean; 
etx,3s,deliesc: integer; 
flength: integer; 
lpage^page: integer; 
trash: integer; 
target: ptype; 



(* NUMBER OF VALID CHARACTERS IN THE EBUF *) 

(* GETLEADING *) 

(* SETS *) 

(* THESE *) 



(* 



OR '<• *) 



(* MOVED TO VAR 26-JAN *) 
(* " " ii ii *) 



{* FOR TOKEN FIND *) 

(* MIDDLE LINE ON THE SCREEN *) 

{* MOVED FROM CONST 30-JAN-78 *) 

(* THE LENGTH OF THE WORKFILE IN PAGES *) 

(* LEFT AND RIGHT STACK POINTERS *) 

(* TOTALLY WITHOUT REDEEMING SOCIAL VALUE *) 
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i:„ 
i : _. 
i:d 
i : ,j 
i:d 
i:d 
i:u 
i:l 
i:a 
i:d 
i:j 
i:d 
i;l 
i:d 
i:a 
i:a 
i:o 
1:5 
1:0 
1:0 
i:o 
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1 
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a 

6: a 
7: a 
a:a 
9:d 



10. 
11, 

12; 
13; 
14; 
15; 



a 

a 
a 
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415 
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419 
4 2 
460 
53 
7ob 
1263 
1309 
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1391 
1903 
1946 
2023 
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substring: 

sllngt-utle 



PTYPE. 
N G T 1 i I 



INTEGER 



(* 
(* 
(* 
(* 
(* 



SDEFIUEDtTDEFINEp: BOOLEAN; 

copyle j&th, cop ys tart: ptrtype; 

COPYLl'-iEtCOPYOK: BOOLEAN! 
INFINITY: BOOLEAN; 
THEFILE; file; 
PR: FILL! 

translate: array c char 3 of commands 
pagezekd: header; 
msg: string; 
promptline: string; 
savetop: string; 
pagebuffer: packed array co 
blankarea: packed array co. 
wfname,backfname: string; 



SEGMENT PROCEDURE NUiw2 
SEGMENT PROCEDURE NUM4 
SEGMENT PROCEDURE N'JM6 
SEGMENT PROCEDURE NUM8 



LENGTH OF TARGET AND SUBSTRING *) 
WHETHER THE STRINGS ARE VALID *) 
FOR COPYC *) 



FOR 



1 *) 

SLASHC *) 



<* DEBUG *) 



(* DUMB TERMINAL 
..10233 OF CHAR; 
.MAXSW3 OF CHAR; 



PATCH - FOR BLANKCRT(l) *) 



BEGIN 


END; 


SEGMENT 


PROCEDURE 


NUM3; 


BEGIN 


end; 


BEGIN 


END? 


SEGMENT 


PROCEDURE 


NUM55 


BEGIN 


end; 


BEGIN 


END; 


SEGMENT 


PROCEDURE 


NUM75 


BEGIN 


end; 


BEGIN 


END; 


SEGMENT 


PROCEDURE 


NUM9 5 


BEGIN 


end; 



(* FORWARD DECLARED PROCEDURES.. ALL PROCEDURES ARE IN MISC AND UTIL *) 

procedure error(s:string;howsad:errortype) ; FORWARD; 

PROCEDURE ERASETOEOL(X»LlNE:lNTEGER) ; FORWARD; 

FUNCTION GETCH:CHAR; FORWARD; 

PROCEDURE CLEARSCREEN; FORWARD? 

PROCEDURE ERASEOS(X,LlNE:iNTEGER) ; forward; 

PROCEDURE CLEARLINE(Y:INTEGER) ; FORWARD; 

FUNCTION MAPTOCOMMANDtCH.'CHAR) : COMMANDS; FORWARD; 

function UCLC(CH:CHAR) : CHAR; forward; 

PROCEDURE PROMPT; FORWARD; 

PROCEDURE REDISPLAY; FORWARDS 

FUNCTION MIN(A»8:INTEGER) : INTEGER; FORWARD; 

FUNCTION MAX(A»B:iNTEGER) : INTEGER; FORwARD; 

PROCEDURE CONTROL(CH:CTYPE) ; FORWARD! 

PROCEDURE PUTMSG; FORWARD; 
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PROCEDURE 
PROCEDURE 
PROCEDURE 
FUNCTION 
PROCEDURE 
FORWARD; 
PROCEDURE 
PROCEDURE 
FUNCTION 

PROCEDURE 
FUNCTION 

PROCEDURE 

PROCEDURE 

PROCEDURE 

PROCEDURE 

PROCEDURE 

PROCEDURE 

PROCEDURE 

FUNCTION 

FUNCTION 

PROCEDURE 



HO IE; forward; 

errwait; forward; 

3lankcrt(y: integer)! forward; 

leadblanks(Pir:ptrtype;var 3 yte:s: integer): integer; forward; 

centercursorivar line: integer; linesup: integer; newscreen:boolean ) 

findxy(var indenttline: integer); forward; 

shjwcursor; forward; 

getnum: integer; forward; 

3etleadin3; forward; 

oktodel(cursor,anchor:ptrtype) :boolean; forward; 

lineoukvar htr;ptrtype; bytes , blanks t line : integer)? forward; 

UPSCREEN(FIRSTLlNEiWH0LESCREEN:300LEAN; line: INTEGER); forward; 

readjust(cursor: ptrtype5 delta: integer); forward; 
thefixer(Paraptr: ptrtypejrfac: integer;whole: boolean); forward; 
getname<msg:string; var m:nawe>; forward; 
getpages(which:leftright) ; forward; 
putpagescwhich:leftright) ; forward; 
readit(which:leftright) : boolean; forward; 
writeit(which:leftright) : boolean; forward; 
checkindent(Var cursor:ptrtype) ; forward; 



I Z E*) 

initialize; 



(*$TI N I T I A L 
SEGMENT PROCEDURE 
LABEL i; 

TYPE phyle=file; 

VAR 

block: ~blocktype; 

onewd: ^integer; 

done,0\/flw: boolean; 

ch: char; 

if quit, gap, blks» page* notnuls: integer? 

filename: string; 

buffer: packed array co. .10230. of char; 

fibarea: ARRAY CO.. 17] of integer; 

procedure map(ch:char; c:commands); 

BEGIN 

TRANSLATECCH3:=C! 

IF CH IN ['A'm'Z'] THEN TRANSLATECCHR(32+0RD(CH) ) ::=c; (* LC TOO *) 

END! 
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procedure cllantitle(VAn t:strimg); 

(* ATTACHLS THE DEFAULT '.TEXT' TO THE END OF THE FILENAME IF NECESSARY. *) 

y. cGIN 

FOR i:=i TO LENGTH(T) DO TC IJ : =UCLC ( TC I j ) ; 

IF (POSI *.TEXT',T)=LENGTH(T)-4) AND ( LENGTH ( T ) >=5 ) THEN 

DELETE(T,LENGTH(T)"4,5) ; 
WFNAME:sCOfJCAT(Ti '.TEXT') ; 

backfna^ie:=concat(t. * .back* j ; 
end; 

PROCEDURE DEFAULTPZ; 
BEGIN 

WITH PAGEZERO DO 

IF DEFINED02 THEN 
3EGIN 

fillchar(buf,1024,chr{0) ) ; 
tokdef:=true; (* default mode is t<oken *) 
filling:=false; autoindent:=true; runoffch:=«"» ; 
lmargin:=o; paramargin:=5; rmargin:=screenwidth; 
(* initialize tabstops - 20-jun-78 *) 

FOR i:=0 TO 15 DO TABSTOPC 1*8 D:=LEFTUUST ; 

created:=thedate; revision:=-i; lastupd:=thedate; 
defined: =2; 

END; 

end; 

procedure changename(var f:phyle; t; string) i 

<* CHANGE THE TITLE OF F TO T. NOTE: (1) THE FILE F MUST BE CLOSED WITH 
CLOSE(F.LOCK), AND (2) THIS CODE RELIES ON A "SPECIAL FEATURE" IN THE 
I/O SUBSYSTEM, NAMELY WHEN THE YEAR IS SET TO 100 THE TITLE GETS UPDATED 
WHEN THE FILE IS CLOSED *) 

VAR 

colon: integer; 

o: daterec; 

fibpa: packed ARRAY CO. .573 of char; 

BEGIN 

<* MAKE SURE THAT THE FILENAME DOESN'T INCLUDE THE VOLUME NAME (OR "*••) *) 

colon:=posc:»,t) ; 

if colon>0 then delete ( t . 1 . colon ) ; 

IF TClD=»*» THEN DELETE ( T , 1 , 1 ) ; 209 
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MOVELE-KFiFIQ^A.ofe) ; (+ TRANSFERS THE FI3 FOR THE FILE F TO FI6PA *) 

MOVELEPT(T,FIEPAC360»16) ! 

WITH D 00 ,>EGIN day: =2; month: =3; YEAR: =100 end? 

MOVELErT(D,FIBPAC560»2) ; 

^GVEL.EFT(Fl3PA*F»5tj) 

end; 

FUNCTION FINQLENGTH<VAR F : PHYLE ): INTEGER ; 
BEGIN 

<* KLUDGE LOGIC. RETURNS THE LENGTH OF THE FILE IN PAGES! *) 

M0VELEFT(F,FIBAREAi36) ; 

findlength: = (fibareac17>fibareac163) div 2; 

end; 

procedure backup; 

(* COPIES THE FILE TC BE EDITED TO ANOTHER FILE* NAMES THE ORIGINAL .BACK. AND 

NAMES THE COPY .TEXT *) 
VAR 

inbnum,0ut3num,0utfsize.blksread.maxbl0ckinbuf: integer! 
ch: char; 
f: file; 

BEGIN 

REWRlTE(Ff BACKFNAME) ' 

if i0re3ultoc then error ( 'can* » t open backup file! '.fatal); 

outfsize:=findlength(F) ; 

if outfslze<flength then errorcnot enough room for backup! •, fatal); 

writel,j( 'copying tc '.backfname)! 

rpage:=outfsize-flength+l! (* push text to the right *) 

inbnum;=2! (* first valid page in the input file *) 

outbnu:v|:=rpage + rpage! (* first block to copy stuff to - right justified *) 

(* copy over the page zero *) 

if blockread(thefi|_e.pagezero, 2,0)02 then 

erro?<( 'reading page zero ', fatal ) ! 
(* compensate for shift in file *) 
with pagezero do 

FOR i:=0 TO COUNT-1 00 

pagenci3:=pagenci3+rpage-1; 
if blockwrite(f, pagezero. 2.0x>2 then 
errorc writing page zero* ♦fatal)? 

maxblockinbuf:=sufsize qiv 512; 

REPEAT 
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711 
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7 
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7; 

8; 

8: 

8; 

a: 

8:i 

8:i 

s:i 

b:i 

a:i 

s:o 



8 
8: 
8; 
8; 



9:d 



9 

9; 

9; 

9: 

9: 
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363 
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430 
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453 
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510 
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42 
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114 
114 
114 

3 

3 



8 
22 





ifJlksreaJoo t'hen " R0R ' ,3A ° ™ put file.., fatal,; 

IF IORESULTOO THEN ERROR CON BACKUP FILE.' 
0UT3rjUM:=0UTdNUM + BLKSREAD; 

inbnum:=inbmum+3lksread 

UNTIL 3LKSREAD=0; 

CHANGE,MAME(THEFILE,BACKFNAME) ; 
CL0SE(THEFILE,L0CK) 



•FATAL) 



CHANSE,MflME(F.WFNAME) « 
CL0SE<F,L0CK)5 

fleimgth:=outfsize; 

RESET (THEFlLEtWFNAME) 

end; 



(* 
(* 



COPY OVER THE LENGTH ATTRIBUTE, *) 
AND MAKE THE FILE YOU COPIED THE WORKFILE! 



*) 



(* DUMB TERMINAL PATCH *, 



PROCEDURE READFILE; 
BEGIN 

clearscreen; 
writelnc>edit:'); 

WRITE('READING') ; 
RESET(THEFILE); 

^ X 3L °CKREAD(THEFILE,PAGEZER0,2)<>2 
GETPAGES(RIGHTSTACK) 

end; 



(* WAS 



D 0TENTIALLY 
THEN 



CLOSED BY BACKUP *, 

ERROR( 'READING FILE', FATAL) 



(* PEOPLE WITH WORD MACHINES — 

FUNCTION BYTESLEFT: INTEGER; 
(* RETURNS THE NUMBER OF BYTES 
BEGIN 

8YTESLEFT;=(* DOUBLE FOR WORD 

end; 



LOOK 



A T 



ME ! I *) 



BETWEEN BLOCK AND LASTMP *) 
MACHINES *> (ORD(SYSCOM-.LASTMP)-ORD(BLOCK)) 



3EGIN 
WITH 



Ragezero DO 
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148 
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396 
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i 


13 


185 


402 


10 


l 
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13 


193 


404 


10 


i 


13 


193 


405 


10 


l 


13 


193 


406 


10 


i 


; 3 


193 


407 


13 


i 


;3 


193 


406 


10 


i 
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(* iUIT THE TRANSLATE TABLE *) 
FlLLCHAP(TRAIMSLATEfSlZEOF(TRANSLATE) .ILLEGAL) ; 



M A P ( 'A 
MAP( 'D 
MAP( • J 
MAP( f M 
MAP ( ' R 
MAP( 'X 

MAp( » . 
MAP( ' + 
MAP( • / 



ADJUSTC) 5 
DELETEC) '■> 
JUMPC) ; 
NEXTC) ; 
REPLACEC) 5 
XECUTEC) ? 

REVERSEO ? 
FORWARDC) 5 
SLASHC) ; 



MAP( 
MAP( 
MAP( 
MAP( 
MAP( 
MAP( 

MAP( 
MAP( 
MAP( 



3' 

c » 



tBANISHC) 
iFINOC) 
L' tLISTC) 
D ' iPARAC) 
S»,SETO ; 

Z',zapc> ; 



>• , FORWARDC) ? 
-•, REVERSEO ? 
=',EQUALC) ; 



map(»o,c0pyc) ; 
map( 'i* ,imsertc) ; 
wap( •m»,macrodefo ; 

MAp(»Q» .QUITO ; 

map( »v»»verifyo ; 



MAP( 



.FORWARDC) 



(* ARROWS *) 



(* NEX 
IF SYS 

3EGI 
MA 
MA 
MA 
MA 

end; 

MAP(SY 

MAp(CH 
MAp(CH 
MAp( CH 



TCOM^AND AND GETNUM HANDLE VT-52 
COM^.CRTCTRL.ESCAPEsCHRtO) THEN 

M 

P(SYSCOM*.CRTlNFO. LEFT. LEFT) ; 

P(SYSCOM^. CRT INFO. DOWN. DOWN) ; 
P(SYSCOM A . CRT INFO. RIGHT. RIGHT) ! 
P(SYSCOM".CRTINFO,UP,UP) J 



MAP( •?• ,DUMPC) J 
MAP( •<• .REVERSEO ; 



STYLE VECTOR KEYS *) 



SCOM~.CRTlNFO.CHARDEL.LEFT) 5 
R(EOL) .ADVANCE) 5 (* CR IS ADVANCE *) 
R(HT) .TAB) 5 
R(SP) .SPACE) ; 



(* [,IGITS *) 

F03 CH:=»0» TO '9' DO MAP(CH. DIGIT) ; 

(* VARIABLE BUFFER SIZING... ADDED 17-JAN-78 *) 
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1:3 


231 


llo 


10 
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340 
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■ J .OiT.-1100u+ (* SlZiGF(EDITCORE)-SIZrOF<lrilTlALIZn *) 

512; (* SLOP! *) 

•JIA^K ( EIBUD ; 

3L<s:=o; 

REPEAT 

MEW (BLOCK); 

3LKS:=BLKS+1; 

3AP:=9YTESLEFT-512 (* 3YTESLEFT RETURNS THE U OF BYTES BETWEEN 
t ,, , THE POINTERS BLOCK AND LASTMP *) 

UNTIL ((GAP>0) AND (GAP«SUIT>) OR <BLKS=63)J 
BUFSlZt:=BLKS*bl2-l; 
IF BUFSIZE<0 THEN BUFSIZE .* =32767 ; 
NEW(ONEWD); ONEWO-:=0l <* SENTINEL FOR END OF BUFFER - FOR M(UN C H *) 

(* OPEN THE WORKFILE *) 

LPAGE:=0; (* LEFT STACK EMPTY *} 

3UF G 0UNT'--* RISHT STACK C0NTAINS ALL 0F THE WORKFILE *) 

cursor:=i; 
clearscreen; 

rtRlTELN(»>EDIT:») i 
IF USERINFO.GOTSYM THEN 
BEGIN 

FILENAME :=cONCAT(USERINFO.SYMV!Di • : • . USERINFO.SYMTID ) ; 
CLEANTITLE(FILENAME); '' 

RESET(THEFILt.,WFNAME); 

IF I0RESULTO0 THEN ERROR( •WORKFILE LOST. • .FATAL) 

END 

ELSE 

BEGIN 

REPE = T N ° W ° RKFILE IS PRE:SENT « FILE? ( <RET> FOR NO FILE ) »! 

WRITE(MSG) ■* 

READLNl INPUT » FILENAME) ; 

IF BEGIN TH(FILENAME,= ° JHEU ( * ° PEN UP G ° 0D ° L ' SYSTEM. WRK. TEXT! *) 

FILENAME : = »*SYSTEM.njRK. TEXT' ; 
CLEANTITLE(FILEMAME) ; 

FILLCHAR(E3UF-,3UFSIZE+l f CHR(0)); 2l'l 
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ON LINE* tFATAL) 5 
THE FILE 



l3UF*C0J:=CHR(E0L) i 

FlLLCHAR(PAGEZERQ,SIZEOF(PAGEZERO) .CHK(O) ) ? 

;<Ert*lTt.(THEFlLEt aTi'MME) ; 

liACKFNAME: = » ' 5 

IF IORESULTOO THEfJ ERROR {♦ SYSTEM VOLUME NOT 

(* ESTABLISH THE LENGTH OF THE FILE AND LOCK 

TO BE THE MAXIMUM EVEN LENGTH *) 
FLENGTH:=FINDLENGTH(THEFILE) ; 
IF OOD(FLENGTH) THEN ^LENGTH: =FLENGTH-1 ; 
IF 3L0CKWRITE(THEFILE» BUFFER tl,2*FLENGTH-l) <>1 

THEN ERROR(»FlLE SYSTEM TERMINAL ERROR •, FATAL ) J 
CLOSE(THEFILE,LOCK) 5 
WITH USERINFO 30 

BEGIN 

symvid:=syvid; symtid:='system.wrk.text» ; gotsym:=true; 
openold(thefile. • *system.wrk.code • ) ; close ( thefile , purge ) 
gotcode:=false; codetid^* 1 

Eimo; 
reset (thefile,'*system.wrk. text*) 5 
rpage:=flength; 
goto 1; 
end; 
cleantitle(filename) ; 

OPENOLDtTHEFlLEtWFNAME) ; 

msg:=»not present, file? •; 
until ioresult=0? 

end; 



(* FIND OUT THE LENGTH OF THE mlORKFILE *) 
FLENG TH :=F I NDLENGTH( THEFILE) ; 

(* IF DESIREDt COPY THE WORKFILE (MAXIMIZING EDITING ROOM) *) 
BACKUP; 



(* READ IN THE FILE *) 
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f r lLLCHAR(E3UF'M3UFSIZr + li r l ,K (0) ■ . 

l3uf"»:oj:=chr(fol) ; 
readfile; 

i: IF (EBUF-C3JFCOUNT-lOOCHK(ECD) OR <BUFCOUNT=l) THEN 

'3 E G I i J 

E3UF*CBUFC0UNT-D:=CHR(E0L) 5 
3UFC0UNT:=3UFC0JNT+l; 

END; 

{* INITIALIZE EVERYTHING ELSE! *) 

DlRECTlOf\i: = '>» ; 

cSpJ5kI=fJlSE? ^^ T ° THE 3ESimiNG 0F ™E SUFFER (FOR EGUALC) •) 

limeiptr:=i; 

with syscc«r.crtinfo do 

BEGIN 

ESC:=ORD(ALTMODE) ; 
ETX:=ORD(EOF) ; 
BS:=ORD(CHARDEL) ; 

del:=ord(lineded; 

screenwidth:=width-i; 

screenheight:=height-i; 

miodle:=(screenheight OIV 2) + l; 

end; 

syscom a .miscinfo.no3Reak := true; 

sdefined:=false; tdefined:=false; {* no substring or target *) 

(* SET UP PAGEZERO IF NEC. *) 

defaultpz; 
revision:=revision+i; 

ENQ<* WITH *} ; 
<* INITIALIZE THE KIND ARRAY *OR JQK g N FINQ *, 
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56b 10 1:i 1&4-1 ^OR CH;=CHH(0) TO CHK(2b5) DO KINDCCH J:=0RD < CH ) ; (* hAKE THEM ALL UNIQUE *) 

53fa 1 ; J i:i 10 71 FDR CH: = 'A» TO »2» DO KINQC CH 3 : = QRD ( • A • ) ? 

J-57 lj in 10-J9 FOR CH;r»A» TO »Z» CO KINDC CH3 : =0RD ( ' A • ) ? 

533 10 l:i 11^7 FOR CH — 'O 1 TO »9« CO K INOC CH 3 : = 3RD ( • A • ) ; 

539 10 l:i 11-35 KINDCCHR(EOL) 3:=ORO( ' •), KINDCCHR (HT) 3 :=ORD(» »); 

540 10 1:1 ii &9 FILLCHAR(3LANKAREA,SIZE0F(BLAMKAREA) .' •); (* FOR UNITWRITING BLANKS *) 

541 10 i:i 1177 SAVETOP:=» »; (* FOR BLANKCRT(l) - SAVES THE PROMPT OR MSG LINE *) 

542 10 1:1 1133 

543 10 1:0 1133 ENO(* INITIALIZE *); 

544 Id 1:0 1214 

545 10 1:0 1214 

546 10 1:0 1214 (*$TO U T*) 

547 11 i:D 3 SEGMENT FUNCTION OUT: BOOLEAN; 
5^8 11 i:D 3 LABEL 1,2; 

549 11 1:0 3 T YPE 

550 11 1ID 3 PHYLE=FILE; 

551 11 i:D 3 vAR 

552 11 i:d 3 save: ptRType; 

553 11 i:D 4 RBNUIHiLBNUM.MAXBLKSlNBUFiBLKSREADtl: INTEGER; 

554 11 i:D 9 BUF: PACKED ARRAY CO. .10233 OF CHAR; 

555 11 i:D 521 FN: STRING; 

556 11 1:0 562 

557 11 2:0 1 procedure changename( var ftphyle; t;string); 

558 11 2 :d 44 {* change: the title of f to t. note: <d the file f must be closed with 

559 11 2:d 44 clost(f»lock) * amd (2) this code relies on a "special feature" in the 

560 11 2:0 44 i/o subsystem* namely when the year is set to 100 the title gets updated 

561 11 2:0 44 when the file is closed *) 

562 11 2:u 44 VAR 

563 11 2:0 44 colon: integer; 

564 11 2:2 45 o: datereic; 

5fo5 11 2:0 t+& FIBPA: PACKED ARRAY CO. .573 C r CHARS 

566 11 2:0 bEGIN 

567 11 2:0 (* WAKE SURE THAT THE FILENAME DOESN'T INCLUDE THE VOLUME NAME (OR "*") *) 

563 11 2:1 colon:=posc:».t) s 

569 11 2:i 18 IF COLy,M>0 THEN DELETE ( T , 1 * COLON ) ; 

5? 11 2:i 52 IF TCl3= , * t THEN DELETE ( T , 1 , 1 ) ; 

571 11 2 -l 47 ^OVELEFT(F, FIBPA, 53) ? (* TRANSFERS THE FIB FOR THE FILE F TO FIBPA *) 

572 11 2:i 55 M0VELEFT(T,FIBPAC383*16) 5 

573 11 2:i 64 WITH D DO 3EGIM DAY:=2; MQIMTH:=3! YEAR;=100 END? 
a7£+ 11 2:i 32 .^0VELEFT(D,FIBPAC:563.2) ; 

575 11 2:i 91 - V 0VELEFT(FI3PA,F,52) 
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end; 

PROCEDURE SETLASTBLOCKCLASTBLOC*: INTEGER) ; 

(* KLUOGI CODE TO REMOVE BLOCKS FROM THE END OF THE WORKFILE *) 

V'AR FI3A-JEA: ARRAY CO.. 12 J OF INTEGER; 

L'EGIN 

1 , 10VELEFT(THEFILE,FIBAREA.26) ; 
FIdAREACl2 3:=LAST3LOCK; 
M0VELEFT(FI6AREA,THEFILE»26) ; 

end; 

BEGIN 

out:=false; 

REPEAT 

clearscreen; (* dumb TERMINAL PATCH *) 
savetop:='>quit: • ; 

WRlTrLN(SAVETOP) ; 

WRITELNC U(PDATE THE WORKFILE AND LEAVE'); 

WRITELNC E(XIT (BUT WORKFILE NOT UPDATED)'); 

WRlTr L NC RETURN TO THE EDITOR WITHOUT DOING ANYTHING'): 

CH:=UCLC(GETCH) ; 
UNTIL CH IN C'U't'E'i'R'D; 
IF CH='R' THEN GOTO 2; 
IF CH='E' THEN 

BEGIM 

out:=true; 

cleaRscreen; 

clqse(thefile, purge) ; 

if length(3ackfname)>0 then 

3EGIN 

RESET(THEFILE,BACKFNAME) ; 
IF IORESULT=0 THEN 
BEGIN 

CHANGENAME(THEFlLEiWFNAME) ; 
CLOSE(THLFILE,LOCK) ; 
END 
ELSE 

WRITELNt 'BACKUP FILE NOT PRESENT (TRIED TO REMOVE IT).'): 
GOTO 2 

ELSE GOTO 2? ^X/ 
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SLAf-jKCru (l) : 

CURS0«:=3UFCOUNT+199i (* TAKES CARE OF THE SLOP! *) 
^JRITE( 'WRITING' ) ; 
PUTPAGrs(LEFTSTACK) \ 

pagezero.lastupq:=thldatE; (* RESET last update DATE *) 

if lpage+i=rpage then begin out:=true; CLEARSCREEN; GOTO 2 END; 

IF LPA3E + 1>RPAGE THEN ERROR (' LPAGE+1>RPAGE ♦. FATAL ) ; 
L3NIjM:=2*(LPAGE + 1) ; 

rbnum:=2*rpages 

MAXBLKSINBUF:=3UFSIZE dim 512? 

REPEAT 

WRITE( •*• ) ; 
BLKSREAD:=BLOCKREAD(THEFlLE,EBUF' % tMAXBLKSlNBUFtRBNUM) ; 

IF I0RESULTO0 THEN GOTO IS 
IF BLKSREADO0 THEN 
BEGIN 

IF BL0CKWRlTE(THEFlLE,E3UF A iBLKSREADtLBNUM)<>BLKSREAD THEN GOTO 1 
IF I0RESULTO0 THEN GOTO 1 
END; 
lbnum:=lbnum+blksread; 
rbnuv);=rbnum+blksread 
until 3lksread=0? 

setlastblock(2*(lpage+l+flength-rpage) ) ; 
(* compensate for gap filled in *) 
with pagezero do 

BEGIN 

FOR i:=0 TO COUNT-1 DO 

if pagencid>=rpage then pagenc i d : =pagenc 1 1- ( rpage-lpage ) +1 ; 
end; 
if block*irite(thefiletpagezerot2»0k>2 then goto 1; 
out:=true; 

WRITELm; 

WRITELi4( 'THE WORKFILE, 'iWFNA^E. 

•» IS • .2*(LPAGE+1+FLENGTH-RPAGE) i • BLOCKS LONG.') 5 
IF LENGTH(3ACKFNAME)>0 THEN WRITECTHE BACKUP FILE IS • , BACKFNAME ) ; 
CLOSE(THEFILE.LOCK) ; 
GOTO 2; 
i:ERROR( 'WRITING OUT THE FILE •. FATAL ) ? 

2:enc; 



658 11 l:i 37 3 

659 11 i:i 878 

660 11 HI 373 (*STC P Y F I L E*J 

66 i 1Z 1:j 1 SEGMENT PROCEDURE COPYFILE; 

6b2 12 l.'D l vAR 

*tl Yt Y'.° 1 STAR TPAGE, STOPPAGE, STARTOFFSET.STOPOFFSET, 

III To ,Ir U l LEFT P^T,PAGE,NOTNuLLS,THEREST,LMOVE: INTEGER! 

\\\ Y : ° 10 DONE.OVFLW: BOOLEAN; 

\\ Ji° 12 BtJF R: PACKED ARRAr CO. .10233 OF CHAR; 

III :% J;° 524 STAR T WARK,STOPiVlARK: PACKED ARRAY C0..7J OF CHAR; 

668 12 i:j D 32 FN! STRING; 

669 12 l:o 573 F: FILE; 

670 12 l:D 613 

671 12 2:D 1 PROCEDURE ERRMARKER; 

672 12 2:0 BEGIN 

67* H HI 5 ° 7 ERRORMIMPROPER MARKER SPECIFICATION.', NONFATAL); 

675 12 2:0 41 END; 

676 12 2:0 54 

677 12 3:D 1 PROCEDURE UNSPLITBUF; 

HI W V?, X ( * STICH THE BUFFER BACK TOGETHER AGAIN. *) 

bf9 12 3.D l V AR BOGOSITY: PTRTYPF; 

680 12 3:0 BEGIN 

HI \l V\\ ° MOV ELEFT(EBUF-CTHEREST3,EBUF^CCURSORD,LMOVE); 

ill \\ \\\ H READJUST(LEFTPART+1,CURS0R-CLEFTPART+1))» 

ita 10 I BUFCOUnt:=BUFC0UNT+CURS0R-(LE^TPART+1); 

685 12 Im II r!r^ H r CK / HAT TW ° DU ' S ™ A R0 " HAVEN'T BEEN GENERATED *> 
faU| 12 3.1 37 CHECKINDENT(CURSOR) ; 

686 12 3:i 42 B0G0SITY:=LEFTPART+1! 

IoI *? 3:1 ^ 9 CHECKINDENT(BOGOSITY); 

688 12 3:0 54 END; 

689 12 3:0 66 

* 90 12 ^D 1 PROCEDURE REAOERR! 

691 12 4:0 BEGIN 

til \\ HI- 1 ° ERR OR( 'MARKER EXCEEDS FILE BOUNDS. • .NONFATAL) ! 

693 12 4:i 3t+ UNSPLIT3UFF5 

tit J! ' +:1 36 CENTERCURSOR(TRASH, MIDDLE, TRUE); 

*o? J? ** !1 * 6 EXIT(COPYFILE) 

° 96 12 4:o 50 end; 

697 12 4:0 62 

698 I 2 5 :D 1 PROCEDURE SPLITBUF; 2J_£| 



o o a 



699 12 5:D 1 (* SPLIT THE BUFFER AT THE CURSOR. THEREST POINTS TO THE RIGHT PART, LMOVE 

7C0 12 b:n 1 IS THE LEJGTH OF THE RIGHT PART, LEFTpART POINTS TO THE END OF THE 'LEFT 

701 12 5:D 1 PART', AMD CURSOR REMAINS UNCHANGED. *) 

702 12 5:a ij C EGIN 

703 12 5:i TH£REST:=BUFSIZE-(BUFCOUNT-CURSOR) ; 

70i 12 5:i 3 lmove:=bufcount-cursor+i; 

705 12 5:i 16 leftpart:=cursor-i; 

706 12 b:i 22 ^lOVERlGHTtEBUF^CCURSORJ.EBUF^CTHERESTJ, LMOVE) 

707 12 5:0 33 END; 

708 12 5:0 46 

709 12 6.*D 1 PROCEDURE PARSEFN; 

710 12 6:D 1 \/AR ItLPTR«RPTRtCOMMfl: INTEGER; 

711 12 6:D 5 MARK: STRING; 

712 12 6:0 BEGIN 

713 12 6:i o lptr:=pos< «c»,fn) ; 

714 12 6:i 15 IF LPTR=0 THEN 

715 12 6:2 20 BEGIN (* WHOLE FILE *) 

716 12 6:3 20 startmark:=» »; 

717 12 6:3 37 ST0PMARK:= • • 

718 12 6:2 41 END 

719 12 6:1 54 ELSE 

720 12 6:2 56 BEGIN 

721 12 6:3 56 RPTR :=P0S( • 3* »FN> ? 

722 12 6:3 71 IF (RPTR=0) OR (RPTR<LPTR) OR (RPTROLENGTH( FN) ) THEN ERRMARKER; 

723 12 6:3 91 MARK : =COPY (FN,LPTR+1 ,RPTR-LPTR-1 ) ; (* STUFF BETWEEN THE BRACKETS *) 

724 12 6:3 114 FN: =COPY ( FN* 1 ,LPTR-1 ) 5 

725 12 6:3 135 COMMA : =POS (• i • ,MARK ) ; 

726 12 613 148 IF COMMA=0 THEN ERRMARKER! 

727 12 613 155 I : =LENGTH ( MARK ) -COMMA ; (* SECOND MARKER PTR *) 

728 12 653 163 MOy/ELEFT ( MARKC 1 It STARTMARK,MIN( 8tC0MMA-l ) ) ; 

729 12 6:3 182 FlLLCHAR ( STARTMARKCCOMMA-1 D,MAX ( ,8- ( COMMA-l ) ) , » •); 

730 12 6:3 203 MO\/ELEFT{MARKCCOMMA+l D» STOPMARK»MlN( 1 .8 ) ) 5 

731 12 6:3 222 FlLLCHAR < STOPMARKC I D» MAX ( » 8-1 )» • ♦) 

732 12 6:2 239 END! 

733 12 6:i 239 FOR i:=Q TO 7 DO STARTMARKC I 3:=UCLC ( STARTMARKC 1 1 ) ; 

734 12 6:i 275 FOR i:=0 TO 7 DO STOPMARK C I H 1 =UCLC ( STOPMARKC 1 1 ) i 

735 12 6:i 311 FOR i:=l TO LENGTH(FN) DO FNC I 21 =UCLC ( FNC I D ) 5 

736 12 6:i 352 IF ( ( PQS ( ' .TEXT* , FN ) <>LENGTH( FN) -4 ) OR 

737 12 6:i 378 ( LENGTH ( FN )<=4 ) ) AND ( FNC LENGTH ( FN )]<>♦.• ) THEN 

738 12 6!2 403 FN : = CO-NCAT ( FN t • . TEXT » ) J 

739 12 6:i 438 IF FNC LENGTH ( FN )H = ». • THEN p ETE ( FN « LENGTH ( FN ), 1 ) ; 
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END; 

PROCEDURE STJFFIT(START,STOP:iNTEGER) ; 

(* PUT THE CONTENTS F BUFR INTO EBUF. OVFLW IS SET TO TRUE WHEN THERE IS 

NO MORE ROOM IN THE BUFFER. *) 
VAR AMOUNT: INTEGER; 
BEGIN 

IF START<=STOP THEN 
BEGIN 

AMOUNT :=STOP-START+i; 

IF CURSOR+AMOJNT+250(*SLOP*)>=THEREST THEN 

3EGIN 

ERROR( 'BUFFER OVERFLOW. •, NONFATAL) T 

cursor:=leftpart+i; 

UNSPLITBUFFJ 
EXIT(COPYFILE) 

END 
ELSE 

BEGIN 

«OVELEFT(BUFRC START ], EBUF^C CURSOR 3 .AMOUNT); 

CURSOR :=cursor+amount 

END 
END 

end; 

PROCEDURE GETNEXT; 

BEGIN 

D0NE:=3LOCKREAD{F,BUFR,2.PAGE+PAGE)<>2; 
IF IORESULTOO THEN 
BEGIN 

errorcbad disk transfer », nonfatal ) ; 

cursor:=leftpart+u 

unsplitbuf; 

EXIT(COPYFILE) 

end; 

WRITE( •••) ; 

IF NOT DONE THEN NOTNULLS : =SCAN{ -1024, <>CHR ( ), BUFRC10233) +1024 

else notnulls:=o; 
page:=page+i; 

end; 

221 
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PROCEDURE CHKOVFLw; 
b £ G I N 

IF (STjpOFFSET>=NQTNULLS) AND ( STOPPAGE<PAGE ) THEN 
BEGIN 

STOPPAGE :=STOPpAGE+i; 

st3poffset:=stopoffset-notnulls; 

end; 
end; 

procedure findmarkers? 

(* given startmark and stopmark find out their page numbers and offsets *) 

VAR 

PZ: HEADER; 

PROCEDURE SEARCH(MNAME:NAME;VAR OFFiPNUM: INTEGER); 
VAR 

i: integer; 

BEGIN 
I * =0 ■ 

WHILE (KPZ. COUNT) AND ( MNAMEOPZ.NAMEC 1 3) DO I: = I + 1J 
IF MNAMEOPZ.NAMECI3 THEN 
BEGIN 

ERRORt 'MARKER NOT THERE. • ,NONFATAL ) ; 
UNSPLITBUFF; 
EXIT(COPYFILE) 
ENd; 
off:=pZ,pcffsetci:; 
pnum:=pz.pagencid; 
if pnum=0 then 

begin off:=off-i; pnum:=i end; (* kludge to MAINTAIN COMPATIBILITY *) 

END; 

8eginu findmarkers *) 
startpage:=i; startoffset:=o; <* default values *) 
stoppage: =32767; stopoffset: =32767; 
if (startmarko' m or (stopmarko* •) then 

BEGIN 

IF BLOCKREAD(F,PZ, 2,0)02 THEN READERR; 

IF STARTMARKO' ' THEN SEARCH< STARTMARK , STARTOFFSET , STARTPAGE ) ; 

IF STOPMARKO* * THEN SEARCH( STOPMARK, STOPOFFSET, STOPPAGE ) 

END 
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PROMPTli.ME: = » COPY: FROM WHAT FILECMARKER.MARKeR!]? «; 
REPEAT 

prompt; 

REAOi_N<FN) ; 

IF LENGTH<FN)=0 THEN EXIT ( COPYFILF" ) ; 

PARSEFN! 

RESET (F.FM) ; 

prom?tlime:=» copy: file not PRESENT. FILENAME? •: 
UNTIL IORESULT=0; 

promptline:=» copy*; prompt? 

splitbjf; 

findmarkers; 

page:=startpage; 

GETNEXT; 

WHILE (STARTOFFSET>=NOTNULLS) AND NOT DONE DO 
BEGIN 

CH'^oVFLW; 

startoffset:=startoffset-motnulls; 
getnext; 
end; 
if (st0ppage<page) and ( stopoffset<notnulls ) then 

stuffit<start0ffset,min(n0tnulls-1,st0p0ffset-1>) 
else 

stuffit(start0ffset,n0tnulls-1) ; 

WHILE ((STOPPAGE>=PAGE) OR ( STOPOFFSET>=NOTNULLS ) ) AND NOT DONE DO 

BEGIN 

chkovflw; 
getnext; 

IF (STOPPAGE<PAGE) AND (STOPOFFSET<NOTNULLS) then 
STUFFIT(O.MIN(NOTNULLS-1»STOPOFFSET-1) ) 

ELSE 

stuffit(o.notnulls-l) 
end; 

if ioresultoo then error(»disk error. * .nonfatal) ; 
unsplitbuf; 

centercurs0r( trash, middle, true) ; 

CLOSE(F); 

end; 223 
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13 


2:7 


106 


886 


13 


2:8 


123 


887 


13 


2:7 


142 


888 


13 


2:3 


144 


889 


13 


2:9 


144 


890 


13 


2:9 


151 


891 


13 


2:9 


167 


892 


13 


2:9 


184 


893 


13 


2:9 


198 


894 


13 


2:9 


212 


895 


13 


2:9 


224 


896 


13 


2:9 


237 


897 


13 


2:9 


250 


898 


13 


2:9 


265 


899 


13 


2:9 


283 


900 


13 


2:9 


299 


901 


13 


2:9 


316 


902 


13 


2:9 


318 


903 


13 


2:9 


364 



(*1TE M v z r? n M e " J T+) 
SEGMENT PROCEDURE ENVIRONMENT; 
y/AR 

1: INTEGER; 

procedure writedate(thedate:daterec) ; 

(* write out (in text) the date. please note the restraint involved in 

not putting in my birthday! (rsk) *) 
var t: string; 

3EGIN 

WITH THEDATE DO 
BEGIN 

IF MONTH=0 THEN WRITE (• NONE • ) 
ELSE 
BEGIN 

IF <MONTH=12> AND (DAY=25) THEN 

WRITE(»CHRISTWAS») 
ELSE 

IF (MONTH=l) AND (DAY=1) THEN 

WRITE ('NEW YEARS*) 
ELSE 

IF (MONTH=10) AND (DAY=3l) THEN 

WRITE( •HALLOWEEN' ) 
ELSE 
BEGIN 

CASE MONTH OF 



1: 


t: = 


•JANUARY* 5 


2: 


t: = 


•FEBRUARY' 5 


3: 


t: = 


•MARCH 1 ; 


4: 


t: = 


•APRIL' ; 


5: 


t: = 


•MAY' ; 




t: = 


♦JUNE* ; 


7: 


t: = 


•JULY' ; 


a: 


t: = 


•AUGUST' ; 


9: 


t: = 


•SEPTEMBER' 


10! 


:t: = 


•OCTOBER 1 J 


Hi 


1 1 • ~ 


•NOVEMBER' ! 


12! 


' T • = 


•DECEMBER* 


END; 


I 




WRITE(T 


tV DAY); 



904 13 2: Li 3 3,5 

^05 13 2:5 5 -.'3 



end; 



90 ' 3 13 2:) 421 END; 

909 13 2:0 446 

**? H V.° X PR °CEDljRE ERASL10; 

l;t tl l' u l var 1: integer; 

912 13 3:o BEGIN 



913 13 3:i 



aRITEC • :10 ) I 



^5 i 3 3 V:0 34 E ^? R I-l TO li QO WRITE(CHR(3SPCE)); 

916 13 3:0 43 

HI 11 tli X PROCEDURE • B00L(B:300LEAN) 5 

yia 13 ^0 BEGIN 

920 13 III 3 S JF? THEN WRITECTRUE.) ELSE rtRITECFALSE-Jl 

921 13 4:o 34 END? 

922 13 4:rj 52 

JSJ ^ sin ! FUNCTION GlTBOOLI BOOLEAN; 

2fl }J J 5 3 VAR CH; CHAR; 

925 13 5:0 BEGIN 

lit 11 ?:J ° eraseio; ch:=uclc(Getch); 

923 II I'l « HHILE N0T (CH IN C'T',»F'3) DO 

929 1, ill 35 8EGIN 

930 II III 35 WRITECT OR F M; 

931 13 5-i Si F0R TRAS H:=0 TO 5 DO WRITE(CHR(BS)); 

Itl V* 2:! 85 ch:=uclc(getch) 

902 13 512 90 END; 

III II V 1 " IF CH = ,Tf THEN 

lit II V 2 1QL * BES I N 

III II V.l 10i+ WRITE! 'TRUE ♦)! 

9^7 II =: 3 12 ° getbool:=true 

937 13 5:2 120 END 

933 13 5:i 123 ELSE 

939 13 5:2 125 BEGIN 



9<+Q 13 5:3 125 



JRlTECFALSE »); 



III 11 V4 111 getbool:=false 

y+2 13 5.2 141 END; 

943 13 5.-0 144 END; 

9^ 13 5:0 1&0 



325 






945 13 6:j 5 FUNCTION GETINT! INTEGER; 

94S 13 aiD 5 VAR 

9»+7 li o:j 5 ch:char; 

9«+8 13 <b:c ^ n: integer; 

949 13 &:o BEGIN 

950 13 611 ERASE10; 

951 13 6:i 2 i\): = 0; 

952 13 &:i 5 REPEAT 

953 13 6:2 5 REPEAT 

954 13 6:3 5 ch:=getch; 

955 13 6:3 12 IF NOT (CH IN C • • . . » 9 • t CHR ( SP ) t CHR ( CR ) 2 ) 

956 13 6:3 31 THEN WRITE( ' « • »CHR ( BELL) »CHR(BS) ) 5 

957 13 6:2 60 UNTIL CH IN C • ' • . • 9» * CHR ( SP ) t CHR { CR ) 3 ; 

958 13 6:2 31 IF C^ IN Z'0'..'S'l THEN 

959 13 6:3 96 BEGIN 

960 13 &:4 96 WRITE(CH); 

961 13 6:4 104 IF N<1000 THEN N:=N*10+ORO (CH) -ORD ( • • ) 

962 13 6:3 117 END; 

963 13 6:1 120 UNTIL CH IN LCHR < SP) t CHR (CR ) D; 

964 13 6:1 129 getint:=n; WRITE! • ') 

965 13 6:0 144 END; 

966 13 6:0 160 

967 13 7:D 1 PROCEDURE TA3SET; 

968 13 7:D 1 VAR 

969 13 7:0 1 x.i,numtimes: integer; 

970 13 7:0 4 

971 13 8:0 1 PROCEDURE SETIT ( CH:CHAR ) 5 

972 15 6:0 2 (* SET THE TABSTOP ACCORDING TO THE CHARACTER PASSED *) 

973 13 8:0 BEGIN 

974 13 8:i WITH PAGEZERO DO 

975 13 8:2 CASE CH OF 

976 13 8:2 3 •N , t»- f : BEGIN CH:= , - , I TABSTOPCX 3: =NONE ; END? 

977 13 8:2 19 t L «: TABSTOPC XI l =LEFTJUST ; 

978 13 8.'2 32 »R»: TABSTOPC X3 1 =RIGHT JUST J 

979 13 8:2 45 »D': TA3ST0PC X 3 : =DECIMALSTOP 

980 13 8:2 54 ENQ; 

981 13 8:i 142 WRITE(CH); 

982 13 3:o 150 END; 

983 13 8:0 162 

984 13 7:0 3EGIN 

985 13 7:1 C WITH PAGEZERO DO 



955, 13 T.2. n ^EGlr 

987 13 7 - 3 CLEARSCREE 

988 15 7 ^ 3 WRITELJ( 

990 13 7J3 f ' SET T ? BS: <RIGHT ' L£ ^T VECTORS> C(OL« CN (0 RCISHT L(EFT DtECIMAL STOP] <ETX>« 

991 13 7'3 97 WRlTELM; 

lH H 7:3 1Qi F0R I: = T0 SCREENWIDTH DO 

993 13 7:^+ im CASE TA3STOPCI2 OF 

994 13 7 :4 124 none: writec-m; 

99 ^ J? 7:,+ 13<+ leftjust: writeclm; 

qq7 :H 1H< * RIGHTJUST: WRITEPRM? 

997 13 7:4 15<+ OECIMALSTOP: WRITE(*D») 

998 13 714 162 EN Q; 

999 13 7:3 187 x:=Q5 

JSS? J? ?:3 19 ° G0T0XY<4,4); WRITECCOLUMN 1* • ) ; 

1001 13 7:3 213 REPEAT 

JSSx il V* 213 G0T0XY<12,4); WRITE ( X+l : 3) ; 

1003 13 7:<+ 228 S0T0XY<X.2>; 

1004 13 7:4 233 CHI =UCLC < GETCH) i 

Tnnf 7» II! 4 2<+5 MUMTIMES:=GETNUM; (* ALSO SETS COMMAND *) 

1007 15 l':t "3 I^CH IN C'N.,'D',«L','R',.-. 3 THEN SETIT(CH) 

1008 13 7-5 277 L i F CH=«C THEN 

1009 13 7.*6 282 BEGIN 

?!n? 13 ?:? 282 G0T0XY(12,4)5 

101? ^ 3:J III X:=MAX(0,MIN<GETINT,SCREENWIDTH+1>-1>; 

1Ui ' J-«5 '.6 309 END 

1013 13 7:S 309 ELSE 

1015 \\ 7- \\\ IF COMMAND=LEFT THEN X:=MAX ( ,X-NUMTlMES ) 

xuij j.o f, a 320 ELSE 

1017 " 7:^ 33I IF^COMMANDrRlGHT THEN X: =MIN(X + NUMTIMES, SCREENWIDTH) 

iSl" " 7: : 3 374 ? UNTIL CH^lSIl 1°" ™ CCHR(ETX) " '» ™ N WRITE (CHR(BELL, , ; 

102J II ]\l sal -nd; :=,$,! ( * S ° WE D ° NfT FALL ° UT ALL 0F THE WAY! * ) 

1022 13 7*0 384 END;"" 

1023 13 7.-0 400 

1024 13 9:0 1 PROCEDURE WRITEMENU; 

1025 13 9:0 3EGIN 

1026 13 9:i WITH PAGEZERO DO pn 7 



'?', 



23 



1027 

1028 

1029 

1030 

1031 

1032 

1033 

1034 

1035 

1036 

1037 

1038 

1039 

10<+0 

1041 

1042 

1043 

1044 

1045 

1046 

1047 

1048 

1049 

1050 

1051 

1052 

1053 

1054 

1055 

1056 

1057 

1058 

1059 

1060 

1061 

1062 

1063 

1064 

1065 

1066 

1067 



13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 



912 
9:3 



9: 

9: 
9: 

Q • 

-* • 

9: 
9: 
9: 
9: 

9: 

9: 

9: 

9: 

9:3 

9:3 

9:3 

9:2 

9:0 

9:o 

io:d 

io:o 

10:1 

10:2 



10 
10 
10 
10 
10 
10 
10 
10 
10 
10 
10 
10 
10 



:3 
:4 
:5 
:5 
:5 
:5 
:4 
:3 

• 7 

1 ^ 

:3 

:4 
:5 
:5 



10:6 
10:5 
10:6 
'.0:5 






6 
3 9 
72 
113 
164 
21U 
254 
238 
321 
327 
397 
467 
523 
583 
663 
669 
669 
682 
1 




9 
9 
38 
93 
144 
156 
156 
191 
203 
221 
221 
234 
248 
256 
258 
291 



3E&I 
WR 
WR 

wa 

WR 

WR 
WR 
WR 
WR 
WR 
WR 
WR 
WR 

WR 



N 

ITELN 

ITE( 

ITE( 

IT£( 

ITE( 

ITE( 

ITE( 

ITEC 

ITE( 

ITELN; 

ITELN 

ITELN 

ITELN 
t 

WRITELN; 
END? 



A(UTO INDENT 
FIILHN5 
L(EFT MARGIN 
R(IGHT MARGIN 
P(ARA MARGIN 
C COMMAND CH 
S(ET TA3ST0PS 
T(OKEN DEF 



SOOL(AUTOINDENT) ; 
BOOL(FILLING) \ 
WRITELNCLMARGIN+1) ! 
WRITELNCRMARGIN+1) : 
WRITELN(PARAMARGIN+1) ! 
WRITELN(RUNOFFCH) 5 
WR ITELN! 
BOOL(TOKDEF) ! 



AVAILABLE.' ) ? 
AND '. 



(BUFCOUNTt» BYTES USED. » .BUFSIZE-BUFCOUNT+1 . » 
(•THERE ARE '.LPAGE,' PAGES IN THE LEFT STACK, 
FLENGTH-RPAGE*' PAGES IN THE RIGHT STACK.'); 
('YOU HAVE » tRPAGE-LPAGE-1.' PAGES OF ROOM.', 
AND AT MOST '.(BUFCOUNT DIV 960)+!,' PAGES WORTH IN THE BUFFER. •)« 



END; 



PROCEDURE WRITEINFO; 
BEGIN 

WITH PAGEZERO DO 
BEGIN 

IF SDEFINED OR TDEFINED THEN 
BEGIN 

WRITELNC PATTERNS:'); 

IF TDEFINED THEN WRITEC <TARGET>= "• .TARGET: TLENGTH, "»•) ; 

IF SDEFINED THEN WRITEC, <SUBST>= •'• .SUBSTRING: SLENGTH, "") ; 

writeln; writeln; 
end; 
if count>o then writelnc markers:'); 
wRite(' •); 
for i:=o to count-1 do 

3EGIN 

WRITEC ')? 
IF PAGENCn = -l THEN 
WRITEC •) 

ELSE 

if pagencI3<=lpage then writec<m else writeo'); 
write(nameiii j) j 



1063 

1065 

1073 

1071 

1072 

1073 

1074 

1075 

1076 

1077 

1078 

1079 

1080 

1031 

1082 

1083 

1084 

1085 

1086 

1087 

1088 

1089 

1090 

1091 

1092 

1093 

1094 

1095 

1096 

1097 

1098 

1099 

1100 

1101 

1102 

1103 

1104 

1105 

1106 

1107 

1108 



13 

13 

15 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 

13 



10 

1G 

10 

10 

10 

10 

10 

10 

10 

10 

10 

1: 

l; 

l; 

i: 

l: 

i; 

i: 

l: 

i: 

i: 

l: 

i: 

i: 

i: 

i: 

l: 

i: 

l: 

i: 

l: 



• o 

: '4 
:3 
:3 

• 7 

• .J 

» 7. 
» O 

:3 
:2 

:o 
;o 

:o 

:i 

12 
13 
3 
3 
3 
3 
3 
3 
4 
4 
4 
5 
4 
5 
5 
5 
5 
5 



115 
1:5 



1 
1 
1 
1 
1 
1 
1 
116 



307 
328 
34o 
3 3d 
362 
3b9 
395 
425 
468 
4b8 
486 




3 
54 
61 
63 
65 
74 
74 
86 
107 
110 
130 
132 
135 
149 
163 
185 
207 
229 
245 
245 
247 
250 
253 
255 
257 
266 



IF (IOCOUMT-1) AND ((1 + 1) MOD 5 = 0) THEN 
BEGIN WRITELN; WRITEC •) End 

end; 



END 



wkiteln; 

wRITELN; 
WRITE( • 
WRlTEt • ; 

writec* (revision •, revision. •).' ) 

end; 



CREATED •) 
LAST UPDATED 



WRITEDATE(CREATED) 5 
' ); WRITEDATE(LASTUPD) ; 



BEGIN 

WITH PAGEZERO DO 
BEGIN 

cleaRScreen; 

promptline:= • environmen 

prompt; needprompt:=true; 

writemenu; 

writeinfo; 

gotoxy( length (promptline) 

REPEAT 

ch:=uclc<getch) ; 

if not (ch in c'a», »c». 

THEN 

BEGIN ERR0R( 'NOT OPTI 
ELSE 

CH OF 

BEGIN 



T: C0PTI0NS3 <SPACEBAR> TO LEAVE»; 
tO) ; 

tp. f . L » t .p, t t R , f i s , ffTtff I,CHR1CR) J) 

0N», NONFATAL) ; PROMPT} END 



CASE 

•a* : 
•f»: 

•l»: 
♦r» : 
i P . . 

♦ c: 
•s«: 



G0T0XY(18 
G0T0XY(18 
G0T0XYQ8 
G0T0XYU8 
G0T0XY(18 
G0T0XYQ8 



»1) 

♦ 2) 

♦ 3) 
t4) 
.5) 

♦ 6) 



BEGIN 
BEGIN 
3EGIN 
BEGIN 
BEGIN 
BEGIN 

TABSET? (* NEW SCREEN DISPLAYED ♦) 

CLEARSCREEN; 

PROMPT; 

WRITEMENU; 

WRITEINFO; 

GOTOXY(LENGTH(PROMPTLINE).0) 
END; 



autoindent:=getbool end; 
filling:=getbool end? 
lmargin:=max(o»getint-d end; 
rmargin:=max(o»getint-d end; 
paramargin:=max(o.getint-d end; 
read(runoffch) end; 



329' 



o> >0 



C^Ji 



1109 13 1:5 263 »T»: BEGirj bOTOX Y ( 18 » S ) ; TQKDEF : =GETBOOL END 

1110 13 1:5 230 END; 

1111 13 1:4 330 SOTOXYdENGTHJ^ROMPTLINE) ,0) ; 

1112 13 1:3 339 UNTIL CH IN C * ♦tCHRtCRjH; 

1113 13 1:3 355 REDISPLAY; 

1114 13 1:2 353 END? 

1115 13 1:0 358 END; 

1116 13 1:0 378 

1117 13 l:o 378 

1118 13 1:0 373 

1119 13 1:0 373 (*$TP U T S Y N T A X*) 

1120 14 1:q 1 SEGMENT PROCEDURE PUTSYNTAX; 

1121 14 1:0 l VAR 

1122 14 1ID 1 D0tDl«D2»BLKtPTRtCOLON: INTEGER; 

1123 14 1:d 7 T.C:pACKED ARRAY C0.-2J OF CHAR; 

1124 14 i:D 11 BUF.'PACKED ARRAY CO. .10233 OF CHAR; 

1125 14 1:d 523 F: FILE; 

1126 14 i:D 563 

1127 14 2ID 1 PROCEDURE PUTNUMl 

1128 14 2:0 BEGIN 

1129 14 2:i MSG:=«SYNTAX ERROR #*; PUTMSG; 

1130 14 2:i 25 WRITE(USERINF0.ERRNUM,». TYPE <SP>')5 

1131 14 2:0 56 END? 

1132 14 2:0 63 

1133 14 i:o BEGIN (* PUTSYNTAX *) 

1134 14 i:i WITH USERINFO DO 

1135 14 1:2 13 BEGIN 

1136 14 1:3 13 OPENOLD(Fi'*SYSTEM, SYNTAX') ; 

1137 14 1:3 38 IF IORESULTOO THEN PUTNUM 

1138 14 l.*3 44 ELSE 

1139 14 1:4 48 3EGIN 

1140 14 1:5 48 IF ERRNUM<=109 THEN BLK:=2 

1141 14 1:5 55 ELSE 

1142 14 1:6 60 IF ERRNUM<=131 THEN BLK:=4 

1143 14 116 69 ELSE 

1144 14 1:7 74 IF ERRNUM<=156 THEN 3LK:=6 

1145 11 1:7 33 ELSE 

1146 11 1:3 88 IF ERRNUM<=254 THEN BLK:=8 

1147 14 i;s 97 ELSE BLK:=10; 

1148 14 1:5 105 IF 3L0CKREAC(F,3UF«2.3LK)<>2 THEN PUTNUM 

1149 14 1:5 123 ELSE 



115y 14 lib 127 BEGIN 

1151 i4 1:7 1^7 if 3Ufco3=chr(Dle:) then ptr:=2 else ptr:=o; 

1152 1+ 1:7 143 O0:=ERRfJUK DIV 100; (* CONVERT ERROR NUMBER TO CHARACTERS *) 
1155 14 1:7 150 Di:=(ERRNUM-D0*100) CIV 10; 

1154 14 1:7 161 D2:=ERRNUM MOD 10! 

1155 14 1:7 16a tco::=chR(dc+ord( ♦0« ) ) 5 TCI i: =CHR ( Dl+ORD ( • • ) ) ; 

1156 14 1:7 1S2 TC2D:=CHR(D2+ORD( »0« ) ) ; 

1157 14 157 189 REPEAT 

1158 14 l.*8 189 FILLCHAR(C.3i '0») ? 

1159 14 1:8 196 COLOn:=SCAN(MAXCHAR,=«:» ,BUFCPTR3) 5 

1160 14 1:8 209 ^OVELEFTtBUFCPTRD, CC3-C0L0N3, COLON) ; 

1161 i4 i:e 220 colon:=colon+ptr; 

1162 14 1:8 225 PTR :=SCAN ( MAXCHAR , =CHR ( EOL ) »BUFCPTR 3) +PTR+3 

1163 14 i:7 238 UNTIL (T=C) OR { BUFC PTR 3=CHR ( ) ) ! 

1164 14 1:7 258 IF BUFCPTRDsCHR ( ) THEN PUTNUM 

1165 14 1:7 266 ELSE 

1166 14 118 270 BEGIN 

1167 14 1:9 270 M0VELEFT(BUFCC0L0N+l3»MSGCl3»(PTR-C0L0N>-4) « 

1168 14 1:9 286 MSGC03:=CHR(MIN(68»(PTR-COLON)-f)) { (* R- REQUIRED *) 

1169 14 1:9 302 HOME; CLEARLINE ( ) ! WRITE(MSG»». TYPE <SP>»)5 

1170 14 1:8 341 END 

1171 14 1:6 341 END 

1172 14 1:4 341 END(* IF IORESULTOO *); 

1173 14 i:3 341 SHOWCURSOR; 

1174 14 1:3 344 repeat until getch=» •; 

1175 14 1:3 353 erRBlk:=o; errsym:=o; errnum:=o; c* only yell onceh! *) 

1176 14 1:2 365 eno(* with userinfo *) 

1177 14 i:o 365 END(* PUTSYNTAX *)? 

1178 14 i:o 392 

1179 14 i:o 392 

1180 14 HO 392 (*$TE DITCORE - BASIC COMMANDS*) 

1181 14 i:o 392 

1182 15 l:D 1 SEGMENT PROCEDURE EDITCORE5 

1183 15 l.'D 1 

1184 15 l:D 1 (* CORE PROCEDURES. EXECUTE THESE COMMANDS UNTIL EITHER A SET ENVIRONMENT 

1185 15 1:0 1 COMES ALONG OR A QUIT COMMAND. *) 

1186 15 i:c 1 

1187 15 i:c 1 

1188 15 1:0 1 

1189 15 2:D 1 PROCEDURE NEXTCOMMAND! FORWARD; 231 

1190 15 2\2 1 



233 



1191 


15 


3:d 


l 


1192 


15 


3:g 





1193 


lb 


3:i 





1194 


15 


3:i 


13 


1195 


15 


3:i 


<>4 


1196 


15 


3:0 


<>7 


1197 


15 


3:o 


42 


1198 


15 


4:d 


1 


1199 


15 


4:d 


1 


1200 


15 


4:o 


1 


1201 


15 


4:o 





1202 


15 


4:1 





1203 


15 


4:1 


45 


1204 


15 


4:1 


52 


1205 


15 


4:1 


55 


1206 


15 


4:1 


91 


1207 


15 


4:1 


108 


1208 


15 


4:2 


113 


1209 


15 


4:1 


114 


1210 


15 


4:2 


119 


1211 


15 


4:3 


124 


1212 


15 


4:1 


128 


1213 


15 


4:1 


145 


1214 


15 


4:0 


145 


1215 


15 


4:0 


162 


1216 


15 


5:d 


1 


1217 


15 


5:d 


1 


1218 


15 


5:d 


1 


1219 


15 


5:0 





1220 


15 


s:i 





1221 


15 


5:1 


3 


1222 


15 


5:1 


82 


1223 


15 


511 


89 


1224 


15 


5:i 


92 


1225 


15 


5:1 


129 


1226 


15 


s:i 


146 


1227 


15 


5:2 


151 


1228 


15 


5:3 


151 


1229 


15 


5:3 


155 


1230 


15 


5:2 


156 


1231 


15 


5:1 


159 



PROCEOuRl FIXDIRECTIOM5 
• EG IN 

IF COM«|AND = FORWARDC THEN DIREC TION : = » > » ELSE DIRECTION : = •<• ; 

HOME; WRITE(DIRECTIQN) ; (* UPDATE PROMPT LINE *> 

SHOwlCURSOR; NEXTCQMMAND 

end; 

proceoure banish; 

VAR 

ch: CHAR; 
BEGIN 

promptline:=' banish: to the L(EFT or right <esc>»; 

PROMPT; needprompt:=true; 

showcursOR; 

REPEAT CH:=UCLC(GETCH) UNTIL CH IN C *L* » *R» «CHR (ESC ) 3 $ 

IF CHOCHR(ESC) THEN BEGIN GOTOXY(7t0); ERASETOEOL( 7* ) END; 

IF CH=»L' THEN 

PUTPAGES(LEFTSTACK) 
ELSE 

IF CHx'R 1 THEN 

PUTPAGES(RIGHTSTACK) ; 
IF CHOCHR(ESC) THEN CENTERCURSOR ( TRASH. MIDDLE, TRUE) 5 

nextcommand 
end; 

procedure next; 

VAR 

ch: char; 

BEGIN 

promptline:= 
' next: F(0RWARDS, 3(ACKWARDS im the file; S(TART. ECND of the file. <esc>* 
prompt; needprompt:=true; 
showcursor; 

repeat ch:=uclc(getch) until ch in c »f» , *b f » *s» , » e» ,chr ( esc ) 3; 
if chochr(esc) then begin gotoxy<5t0); erasetoeol ( 5 » ) end; 
if ch=»f' then 

BEGIN 

PUTPAGES(LEFTSTACK) ; 
GETPAGES(RISHTSTACK) 
END 
ELSE 



l^H 15 5:2 l&l ir CH=»B» THEN 

J??* f)? ?*' 4 1S6 PUTPAGES(RIGHTSTACK); 

x*36 lb 5:3 171 en 3 

1237 15 5t2 174 ELSE 

Jf« J* ^ :3 1?6 IF CH= ' S ' THEN 

1239 15 5:4 131 3EGIN 

JI2? \% I!? 1S1 WH1LE "-PAG E >0 DO 

1241 15 516 188 3EGIN 

1243 ^5 siy too ^GOTOXY(5.0); ERASETOEOL ( 5 , ) ; 

J:!: " I' 1 198 cursor:=i; 

1245 15 III 5ni PUTPAGES(RIGHTSTACK); 

\tll \l III ? 05 GETPAGES(LEFTSTACK) 

l<i46 15 5:6 2C6 end; 

\ttl 11 V 5 211 cursor:=i 

1248 15 5:4 211 E ND 

1249 15 5:3 214 



ELSE 



THEN 



1250 15 5:4 216 j F CH='E 

1251 15 5:5 221 BEGIN 

\l\\ \l lit ll 1 WHILE «PAGE<FLENGTH DO 

1*^33 15 5!7 230 BEGIN 

1255 H 111 tin GOTOXY(5,0>; ERASETOEOL ( 5, > | 

lill " III J'fo cursor:=bufcount-i; 

1257 ^ til HI PUTPAGLS(LEFTSTACK); 

1258 1? Ill III GETPAGES(RIGHTSTACK) 
1<258 15 5:7 250 ENDS 

1259 1 S S't ~kc L u ' 

1260 is lit tit en Cursor:.bufcount.ii 

«M " 5 5 !i g? j5^H<>CH|J(ESC. THENCENTCRCURSOR«TRASH,«ODLE.TRU e) , 

1263 15 5:0 277 END; 

1264 15 5:0 296 

1265 15 6:D l PROCEDURE COPY; 

1266 15 6:o BEGIN 

lltl 11 V-\ a? ^MPTLINE: = . COPY: B(UFFER FIROM FILE <ESC>«; 

Tola \l %1 41 pr ompt; needprompt : =true; 

1*269 15 611 i+8 REPEAT 

\IVI H 6:2 tf8 CH:=UCLC(GETCH); 

1272 i3 b: i 83 IF CH= , 5 , the;n 2^3 
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1275 
1274 
1275 
1276 
1277 
1278 
1279 
128Q 
1281 
1282 
1283 
1281 
1285 
1286 
1237 
1288 
1289 
1290 
1291 
1292 
1293 
1294 
1295 
1296 
1297 
1298 
1299 
1300 
1301 
1302 
1303 
1304 
1305 
1306 
1307 
1308 
1309 
1310 
1311 
1312 
1313 



15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 



o 

S 
6 
6 
6 
6 
6 
6 
6 
6 
6 
6 
6 
6 
6 
6 
6 
6 
6 
6 
6 
6 
6 
6 
6 
6 
6 
o 
6 
6 
6 
6 
6 
7 
7 
7 
7 
7 
8 



3 
3 
3 
3 
4 
4 
5 

;6 

7 
IS 
!8 
7 
16 
16 
7 
6 
7 
6 
6 
6 
6 
6 
6 
6 
6 
6 
5 
2 
1 
2 
1 
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D 

1 


D 



3 b 
c3 
103 
1C9 
129 
131 
154 
159 
159 
164 
164 
167 
167 
170 
185 
198 
213 
215 
226 
233 
240 
245 
248 
255 
260 
263 
272 
279 
282 
282 
284 
293 
296 
298 
316 
1 


2 
14 
1 



3EGIM 

if not copyok or ( ( bufcount+copylength+10>copystart ) 

and (c0 d ystart>=8ufc0unt) ) 
then error( f invalid copy .♦. nonfatal ) 
-:lse 
if bufcount+copylength>=bufsize then error(»no room' , nonfatal ) 

ELSE 
BEGIN 

IF COPYLINE THEN 
3EGIN 

getleading; 
cursor:=linestart 

END; 
MOVER IGHT(EBUF~C CURSOR 3 iEBUF~CCURS0R + C0PYLENGTH3tBUFC0UNT-CURS0R+l) 

IF (COPYSTART>=CURSOR) AND (COPYSTARKBUFCOUNT) THEN 

MOVELEFT(EBUF" > CCOPYSTART+COPYLENGTH3,EBUF~CCURSORD.COPYLENGTH) 

ELSE 

moveleft(ebuf~ccopystart:],ebuf~c cursor d,copylength) ; 

bufcount : =BUFCOUNT+COPYLENGTH X 

readjust(cursor»copylength) ; 

checkindent(cursor) ; (* check the border for two dle's *) 

lastpat:=cursor; (* for equalc *) 

cursor :=cursor+copylength; 

checkindent(cursor) ; (* ... and also check the other border *) 

getleading; 

cursor:=max(cursortstuffstart) ; 

centercursort trash. mi dole. true) 

END? 
END (* CHs'B' *) 
ELSE 

IF CH='F» THEN EXIT ( EDITCORE ) ; 

showcursor; 
nextco^imand; 
end(*copy*) ; 

procedure dump; 

5EGIN 

nextcommand; 

END(* DUMP *) ; 
PROCEDURE FIND; FORWARD? 



1314 is arc i 

1315 15 9:o L PROCEDURE INSEKTIT; FORWARD; 

1316 15 i:o 1 

1317 15 10:j 1 PROCEDURE JUMP; 

1318 15 io:d 1 VAR CM: char; 

1319 15 lOJD 2 

1320 15 11 :Q l PROCEDURE JUMPMARKER; 

1321 15 ll:D 1 VAR 

1322 15 HID 1 MUSTREDISP: BOOLEAN! 

1323 15 1X:j 2 I.* INTEGER? 

1324 15 HID 3 MNAME: PACKED ARRAY CO. .73 OF CHAR; 

1325 15 ll:D 7 

1326 15 12.*D 1 PROCEDURE SHUFFLE; 

1327 15 12:u BEGIN 

1328 15 12:0 (* must redisplay the screen *) 

1329 15 12:1 mustreqisp:=true; 

1330 15 12:i 4 WITH PAGEZERO DO 

1331 15 12:2 4 BEGIN 

1332 15 12:3 4 CLEARLINE(O); 

1333 15 12:3 8 WRITECLEAPINGM ! 

1334 15 12:3 25 IF PAGENCIX=LPAG£ THEN 

1335 15 12:i M-0 WHILE (LPAGE>0) AND (PAGENC I JO-1 ) DO 

1336 15 12:5 60 BEGIN 

1337 15 12:6 60 GOTOXY(7»0); ERASETOEOL ( 7. ) ; 

1338 15 12:6 70 CURSOR:=U 

1339 15 1216 73 PUTPAGES(RIGHTSTACK) ; 

1340 15 12:6 77 GETPAGES(LLFTSTACK) 

1341 15 12:5 78 END 

1342 15 1213 81 ELSE 

1343 15 12:4 85 WHILE (RPAGE<FLENGTH) AND ( PAGENC I 3<>-l ) DO 

1344 15 12:5 107 BEGIN 

1345 15 1216 107 GOTOXY(7,0); ERASETOEOL ( 7. ) 5 

1346 15 12:6 117 cursor:=bufcount-i; 

1347 15 12:6 122 PUTPAGES(LLFTSTACK); 

1348 15 12:6 126 GETPAGES(RIGHTSTACK) 

1349 15 12:5 127 END 

1350 15 1212 130 END 

1351 15 12:0 132 END; 

1352 15 12:0 148 

1353 15 ll:o BEGIN w, 

1354 15 11:1 mustredisp:=false; ^ J; 






1355 15 li:i 3 WITH PAGEZERO JC 

13^6 15 11:2 3 3ESI j 

1357 15 11J3 3 &ETNAMi( • JUMP TC * » MfjAME ) i 

1358 15 11:3 19 IF iwiNAMEO 1 ' THEN 

1359 15 11:4 36 3EGIN 

1360 15 11:5 36 " i:=o; 

1361 15 11:5 39 ^HILE (KCOUNT) AND < WAMEONAMEC 1 3) DO I : = I + 1 { 

1362 15 11:5 65 IF MNAMEONAHEC 1 1 THEN 

1363 15 ll:& 78 ERRORCNOT THERE. ». NONFATAL ) 

1364 15 11:5 92 ELSE 

1365 15 1156 97 BEGIN 

1366 15 11:6 97 {* IF TEXT POINTED TO ISN'T IN THE BUFFERi LOAD IT IN *) 

1367 15 11:7 97 IF PAGENCIDO-1 THEN SHUFFLE; 

1368 15 11:7 111 IF PAGENCIDO-1 THEN ERROR (• MARKER ALL MESSED UP. • , NONFATAL) 

1369 15 11:7 148 ELSE 

1370 15 11:8 153 CURS0R.*=P0FFSETCID5 

1371 15 11:7 162 GETLEADING; 

1372 15 11:7 165 CURSOR;=MAX(CURSOR,STUFFSTART) ; 

1373 15 11:7 174 CENTERCURSOR(TRASHtMIDDLE»MUSTREDlSP) 

1374 15 11:6 161 END5 

1375 15 11:4 184 END; 

1376 15 11:2 184 END; 

1377 15 li:0 184 END; (* JllMPMARKER *) 

1378 15 li:o 200 

1379 15 10:0 BEGIN (* JUMP *) 

1380 15 10:i PR0MPTLINE: = » JUMP: BEGINNING E(ND MURKER <ESO»{ 

1381 15 10:i 44 PROMPT; 

1382 15 10:1 47 NEECPROMPT:=TRUE; (* NEED TO REDISPLAY EDIT: PROMPTLINE! *) 

1383 15 10:1 51 REPEAT 

1384 15 10:2 51 CH:=UCLC(GETCH) ; 

1385 15 10:2 &3 IF CH='B« THEN 

1386 15 10:3 68 BEGIN 

1387 15 10:4 68 cuRsor:=i; 

1388 15 10:4 71 GETLEADING! 

1389 15 10:4 74 cursor:=stuffstart; 

1390 15 10:4 77 ce'jtercursor(trash»l»false) 

1391 15 1053 32 END 

1392 15 10:2 65 ELSE 

1393 15 1UI3 87 IF cH=»E» THEN 

1394 15 10:4 92 5EGIN 

1395 15 \0:5 92 CURSOR:=BJFCOUNT-li 



1397 15 loll ill -■ ^ EriTERCURS0Rl rRASti,SCR£LNHEIGHT-l, FALSE) ! 

1338 15 10:3 107 ELse" 

Jarn J! JS!? J 03 IF CH=»M» THEN JUMPMARKER 

i^oi ^ ,S ? J" ElSE if ch <>chk(Eso then err^ait; 

Unl J- JJ'J 128 UNTIL (CH IN C»d«.-£',TV,CHR(ESC)3M 

1402 l-o 10:1 151 NEXTCO-JIMANO; 

1403 15 10:0 153 END; 

1404 15 10:0 163 

1405 15 13:d 1 PROCEDURE DEFMACR05 

1406 15 13:o BEGIN 

1408 is f?l* ,2 WI ™ PaGEZER0 D0 IF FILLING AMD NOT AUTOINDENT THEN 
nuo x *> 10.3 10 BEGIN 

1409 15 13:4 10 3LANKCRTUII 

1*11 i5 J?:! J" TH E FlXER(CURSOR,REPEATFACTOR,TRUE); 

iuip it i,:J !° CENTERCURSOR(TRASH, MIDDLE, TRUE)! 

lHitj 15 13I3 30 END 

ltll J? Jxlf ?,° ^ LSE ERR0R( ' INAPPROPRIATE ENVIRONMENT', NONFATAL); 

ihih 15 13,1 6(f copyok:=false; 

1*15 15 13:i 68 SHOWCURSOR; 

1416 15 13:i 71 NEXTCOViMAND; 

1417 15 13:0 73 END; 

1418 15 13:0 86 

1419 15 14:D 1 PROCEDURE SETMARKER; 

1420 15 X4:o 1 LABEL l; 

1421 15 14:D 1 V AR 

}^ is 14:d 1 1, slot: integer; 

llll \l J2IS 3 P . MNAM ^ : P AC «CD ARRAY CO. .73 OF CHAR; 

l'+^f 15 14:0 BEGIN 

1425 15 m;i WITH PAGEZERO DO 

1426 15 14:2 BEGIN 

JupI 15 ltf:3 ° NEEDPR0MPT.*=TRUE! 

! tl ^ :3 4 count:=min(20, count); 

!; " ^ :3 16 IF COUNT=20 THEN 

1430 15 14:4 23 3EGIN 

J!hJ !? ^ 4:5 23 BLANKCRTd,; 

1433 15 lal" 11 F ° R I:= ° T0 "U^" 1 D0 

1434 3EGIN 

1435 15 JJI J a? WRITE(CHR(ORDCAM + I),M • , NAMEC I 3, ' •); 

143 3 6 15 ilil 1^ EN J F < I + 1 > M °° * = ° THEN WRITELN; 33 



t^% <H% •""-> 



1437 15 1 4 J 5 11* ,v ISj! = 

1433 la 14-5 116 'r'A^KE^ OVERFLOW. WHICH ONE TO REPLACE? (TYPE IN THE LETTER OR <SP>) »; 

1439 15 14:5 190 PUTMSG; CH : =UCLC ( GETCH ) ; 

i44j 15 14:5 205 centercursqr(trashimiddle,true) 5 

1441 15 14:5 215 IF CH IN C . a ' . . • T • D THEN SLOT : = QRD ( CH ) -ORD ( • A • ) 

1442 15 14:5 236 ELSE 

1443 15 14:6 2m GOTO 1! 

1444 15 14:4 243 END 

1445 15 14:3 243 ELSE 

1446 15 14:4 245 SLOT : =COUNT ; 

1447 15 14:3 250 GETNAME ( •SET* tMNAME ) I 

1448 15 14:3 261 IF MNAMEO* ' THEN 

1449 15 14:4 279 BEGIN 

1450 15 14:5 279 FOR I!=0 TO COUNT-1 DO 

1451 15 14:6 294 IF NAMEC I D=MNAME THEN SLOT:=I; 

1452 15 14:5 317 NAMECSLOT :J:=MNAME; 

1453 15 14!5 327 POFFSETCSLOT J:=CURSOR ; 

1454 15 14:5 335 PAGENCSLOn: = -l ; 

1455 15 1415 344 IF SLOT=COUNT THEN COUNT : =COUNT+l 

1456 15 14:4 354 END! 

1457 15 14:2 359 END; 

1458 15 14:1 359 llENDl 

1459 15 14:1 378 

1460 15 15:D 1 PROCEDURE SETSTUFF5 

1461 15 15:D 1 VAR CH: CHAR; 

1462 15 15:0 BEGIN 

1463 15 1511 o promptline:=» set: environment M(ARKER <esc>'i 

1464 15 15:1 40 PROMPT; NEEDPROMPT : =TRUE ; 

1465 15 15:1 47 REPEAT 

1466 15 15:2 47 CH : = UCLC ( GETCH ) ; 

1467 15 15:2 59 IF CH=»E» THEN EXIT ( EDITCORE ) 

1468 15 15:2 68 ELSE 

1469 15 15:3 70 IF CH='M' THEN SETMARKER 

1470 15 15:3 75 ELSE IF CHOCHR(ESC) THEN ERRwAIT; 

1471 15 15:i 39 UNTIL CH IN C * E • » • M' • CHR ( ESC ) 1 ? 

1472 15 15:i ill SHOWCUSSOR; 

1473 15 15:1 114 NEXTCOviMAND; 

1474 15 la:0 116 E.ND(* SET5TUFF *); 

1475 15 15:0 130 

1476 15 16:D 1 PROCEDURE VERIFY; 

1477 15 \6:0 3EGIN 



14 73 


lb 


loll 





1479 


15 


l&: l 


10 


1480 


Id 


16: i 


13 


1431 


lb 


16 :o 


13 


1482 


lb 


1 6 : u 


2S 


1483 


15 


17:d 


1 


1484 


15 


x7:d 


1 


1485 


15 


i7:o 


1 


1486 


lb 


17:o 


3 


1437 


15 


i7:o 





1488 


15 


I7:i 





1489 


15 


17:1 


63 


1490 


15 


i7:i 


75 


1491 


15 


i7:i 


78 


1492 


15 


I7:i 


81 


1493 


15 


17:1 


34 


1494 


15 


17:2 


84 


1495 


15 


17:2 


91 


1496 


15 


17:3 


101 


1497 


15 


17:4 


101 


1498 


15 


i7:s 


106 


1499 


15 


17:& 


106 


1500 


15 


17:6 


116 


1501 


15 


17:6 


123 


1502 


15 


17:5 


149 


1503 


15 


17:3 


149 


1504 


15 


17:2 


149 


1505 


15 


17:3 


151 


1506 


15 


17:3 


162 


1507 


15 


17:4 


164 


1508 


15 


17:5 


184 


1509 


15 


17:6 


184 


1510 


15 


17:6 


212 


1511 


15 


17:6 


219 


1512 


15 


17:6 


223 


1513 


lb 


17:6 


233 


1514 


15 


17:5 


241 


1515 


15 


17:1 


241 


151b 


15 


17 :i 


254 


1517 


15 


17:2 


261 


1518 


15 


17:3 


261 



CENT ERCURSO?{TR ASH ,«1 DOLE, TRUE) ; 
SHOWCURSOR; 
NEXTCO^mAND 
END (* VERIFY *) J 

PROCEDURE XMACRO; 
VAR 

SAVECti: INTEGER! 

save:packeo array co..maxstrimgd of char; 

BEGIN 

p«n^I LI ^ : = ' EXCH A'^^ TEXT C<3S> A CHARD C<ESC> ESCAPES; <ETX> ACCEPTS!]'; 

PROMPT; needprompt:=true; 
showcursor; 
savec:=cursor; 
i :=oi 

REPEAT 

ch:=getch; 

if maptocommand(ch)=left then 

BEGIN 

IF (CURSOR>SAVEC) THEN 
BEGIN 

i:=i-i; cursor:=cursor-i; {* decrement both ptrs *) 
ebuf*ccursor::=savecid; c* restore buffer *) 
write (chr(bspce)tebuf^c cursor d.chr (bspce) ) 5 

END 
END 
ELSE 

IF CH=CHR(E0L) THEN BEGIN ERRWAIT; SHOWCURSOR END 
ELSE 

IF NOT (CH IN tCHR(ETX)tCHR(ESC)3) AND ( EBUF*CCURSORJOCHR (EOL) ) THEN 

BEGIN 

IF NOT (CH IN [• •..•*•]) THEN CH:=»?»; 
SAVEC I 3:=EBUF*C CURSOR]; 
EBUF^CCURSORDirCH; 

i:=i+i; cursor:=cursor+i; 

WRITE(CH) 
END; 
UNTIL CH IN CCHR(ETX),CHR(ESC) J; 
IF CH=CHR(ESC) THEN 

BEGIN Pla 

CURSOR:=SAVEC; ^^^ 



210 



15i : i lb 17:3 264 MOtfELEFTlSAVLCODtEBUF^CCU^SJRDiI) ; 

1520 15 17:3 272 SHC/.CUR30R; WRITE { SAVE: I ) ! SHOWCURSOR 

1521 15 1712 2d7 end; 

1522 15 17:1 290 NEXTCO-JIMANu; 
i523 15 17: 292 rND (* X'ACRJ *); 

1524 15 17:0 3C6 

1525 la 18:D 1 PROCEDURE ZAPIT; 

1526 15 18:0 EGIN 

1527 15 18:i IF ABS<lASTPAT-CJRSOK)>80 ThEM 
1520 15 18:2 3 BEGIN 

1529 15 18:3 8 PRDMPTlINE: = 

1530 15 18:3 11 t WARNING! YOU ARE ABOUT TO ZAP MORE THAN 80 CHARSt DO YOU WISH TO ZAP? <Y/N)'s 

1531 15 18:3 92 PROMPT; 

1532 15 18:3 95 NEEQPROMPT: =TRUE ? 

1533 15 18:3 99 IF UCLC ( GETCH) <> ' Y' THEN 

1534 15 18:4 113 3EGIN 

1535 15 18:5 113 SHOWCURSOR; 

1536 15 18:5 116 NEXTCOMMAND ! 

1537 15 18:5 118 EXIT(ZAPIT) 

1538 15 18:4 122 END! 

1539 15 18:2 122 ENDS 

1540 15 1811 122 IF 0KT3DEL(MIN(CURS0RtLASTPAT),MAX(CURS0R»LASTpAT)) THEN 

1541 15 18:2 143 BEGIN 

1542 15 18:3 143 COPyLlNEI =FALSE 5 

1543 15 18:3 147 READJUST ( MIN ( CURSOR .LASTPAT )» -ABS< CURSOR-LASTPAT) ) ! 

1544 15 18:3 162 IF c JRSOR>L_ASTpAT THEN 

1545 15 18:4 167 MOVELEFT ( EBUF~CCURSOR 3 i EBUF^CLASTPAT 3, BUFCOUNT-CURSOR ) 

1546 15 18:3 176 ELSE 

1547 15 18:4 178 UOVELEFT ( EBUF^LASTPATU, EBUF^CCURSOR 3,BUFCOUNT-LASTPAT ) ; 
1543 15 1813 187 BUFCOUNT :=3UFC0UNT-ABS ( CURSOR-LASTPAT) { 

1549 15 18:3 195 CURSOR : =LASTPAT ! 

1550 15 18:3 198 CENTERCURSOR < TRASH , MIDDLE » TRUE ) ! 

1551 15 18:2 208 END? 

1552 15 18:i 203 SHOWCURSOR; 

1553 15 13: 1 211 NEXTCOmmAND 



LJ t 



1554 15 18:o 213 END! 

1555 15 18:0 226 

1556 15 18:0 226 (*$TI N S E R T C M M A N D*) 

1557 15 18:0 22b 

1558 15 9.-D 1 PROCEDURE INSERTIT; 

1559 15 9:D 1 CONST 



1560 


15 


9: :; 


1 


1561 


15 


9: j 


1 


1562 


15 


3:\j 


1 


1563 


15 


9: j 


4 


1564 


15 


3:d 


10 


1565 


15 


9:d 


16 


1566 


15 


9:d 


31 


1567 


15 


19:q 


1 


156b 


15 


19 :c> 


1 


1569 


15 


i9:a 


1 


1570 


I 'j 


19:d 


1 
L 


1571 


15 


19:d 


1 


1572 


15 


19:o 





1573 


15 


19:1 





1574 


15 


I9;i 


3 


1575 


15 


I9:i 


11 


1576 


15 


i9:i 


19 


1577 


15 


19:1 


30 


1578 


15 


i9:i 


33 


1579 


15 


19:2 


42 


1580 


15 


19:3 


42 


1581 


15 


19:3 


67 


1582 


15 


19:3 


70 


1583 


15 


19:3 


72 


1584 


15 


19:2 


76 


1535 


15 


19:2 


76 


1586 


15 


19:1 


76 


1587 


15 


i9:o 


94 


1588 


15 


19:0 


106 


1589 


15 


2o:d 


1 


1590 


15 


2o:d 


1 


1591 


15 


2o:d 


1 


1592 


15 


2o:d 


1 


1593 


15 


2o:d 


1 


1594 


15 


2o:d 


1 


1595 


15 


2o:d 


2 


1596 


15 


20:0 


. 


1597 


15 


20:1 





1598 


15 


20:2 





1599 


15 


20:2 


3 


1600 


15 


20:2 


22 



fudgefactor=u ; 

V'AK 

THEREST.LEFTPART,SAVtBUFCOUMT: PTRTYPE; 

CLEARED, WARNED, OK, NOTEXTYET,EXITPROMPT,FIRSTLlNE: BOOLEAN: 
SPACES, LMOVE,X,LIiJE.EOLDlST,RjJST: INTEGER; 
context: PACKED ARRAY C0..MAXSTRING3 of char; 



PROCEDURE SLAMRIGHT; 

(* MOVE (SLA«I) THE PORTION OF THE EBUF~ TO THE 
THE CURSOR SO THAT THE LAST NUL IN THE FILE 
EBUF^CBUFSIZED. THEREST POIMTS TO Tt 
TEXT. *) 

BEGIN 

GETLEAQING; 

THEREST :=BUFSIZE-(3UFC0UNT-CURS0R); 

lmove:=bufcount-cursor+i; 

MOVERISHT(EBUF-CCURSORD,EBUF^CTHEREST3,LMOVE) 
GETLEADING; (* SET BLANKS *) 

IF THEREST-CURSOR<MAXSTRlNG THEN 

BEGIN 



RIGHT OF (AND INCLUOING) 
(EBUF^CBUFCOUNTD) IS NOW AT 
3EGINNING OF THE RIGHT-JUSTIFIED 



error( 'no room 

showcursor; 

nextc0wmand5 

exit(insertit) 
end; 
(* optional indentation *) 
ebuf a ctherest-2d:=chr(dle) ; 



TO INSERT. '.NONFATAL) 



end; 



E3UF^CTHEREST-ia:=CHR(BLANKS+32) 



PROCEDURE WRAPUP; 

(* GIVEN THE NEW VALUE OF THE CURSOR (ONE PAST THE LAST VALID CHARArTFR 
INSERTED INTO THE BUFFER), PUT BACK TOGETHER THE ill HALVES OF 1HL 

?HE EDITOR CAN Up?*]*" " ° FF ' ^^ ™ E ^^ S ° ™ AT ™ E «" T 0F 

var ptr: ptrtype; 

lngth: integer; 
begin 

with pagezero do 

IF NOTEXTYET AND (NOT FIRSTLINE) AND 

((NOT FILLING) OR AUTOINDENT) AND ( CHOCHR ( ESC ) ) 
THEN (* WE WANT THE BLANKS 3EF0RE THEREST *) 



24! 
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15 
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SO 
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15 


2014 


25 


1603 


15 
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oO 
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lb 


2014 


46 


1605 


15 


20 : 3 


63 


1606 


15 


20 :i 


63 


1607 


15 


20:1 


74 


1603 


15 


20:1 


89 


1609 


15 


20:1 


100 


1610 


15 


20:2 


100 


1611 


15 


20:3 


116 


1612 


15 


20:1 


135 


1613 


15 


20:1 


153 


1614 


15 


20:1 


156 


1615 


15 


20:1 


165 


1616 


15 


20:1 


172 


1617 


15 


20:1 


166 


1618 


15 


20:0 


186 


1619 


15 


20:0 


200 


1620 


15 


2i:d 


3 


1621 


15 


2i:d 


4 


1622 


15 


2i:d 


4 


1623 


15 


2i:d 


4 


1624 


15 


21:0 





1625 


15 


21:1 





1626 


15 


21:1 


3 


1627 


15 


21:2 


10 


1628 


15 


21:3 


10 


1629 


15 


21:3 


17 


1630 


15 


21:3 


53 


1631 


15 


21:2 


62 


1632 


15 


21:1 


62 


1633 


15 


21:2 


64 


1631 


15 


21:3 


75 


1635 


15 


21:4 


75 


1636 


15 


21:5 


81 


1637 


15 


21:6 


81 


1638 


15 


21:6 


121 


1639 


15 


21:6 


130 


1640 


15 


21:5 


130 


1641 


15 


?i:<+ 


134 



3L~3I.NI 

3UFC0UMT:=3JFC0UNT+2t 
THlR£3T:=THErEST-2; LM0Vl:=LM0VE+2; 

CURSOR :=SCAf\i<-MAXCHARi=CriR(EOL> tEBUF^CCURSOR-l 1 )+CURS0R! 
END; 
M0VELEFT<E3UF*CTHERESTDfEBUF*C CURSOR 3 iLMOVE) ; 
REAQJU$T(LEFTPART+1,CURS0R-(LEFTPART+1) ) ; 
BUFC0Unt:=3UFC0UNT+CURSCR-(LEFTPART+1) ; 
WITH PAGEZERO DO 

IF FILLING AND MQT AUTOINDENT AND < CH=CHR < ETX > ) THEN 

BEGIN THEFIXLR(CURSORfltFALSE); FIRSTLINE:=FALSE; FINDXY ( X, LINE ) END; 

upscreencfirstlineiexitprompt or < ch=chr (esc ) ) » line ) ! 
getleading; 

cursor:=max(cursor,stuffstart) ; 
lastpat:=leftpart+i ; 

copyok:=true; copystart:=lastpat; copylength:=cursor-lastpat; 

nextcommand 
END; 

FUNCTION CHECK(VALUE:INTEGER): BOOLEAN; 

(* VALUE IS THE POTENTIAL VALUE OF THE CURSOR. IF IT IS NOT IN LEGAL 
RANGE THEN CHECK IS FALSE. THIS FUNCTION ALSO WARNS THE USER IF 
S/HE IS GETTING TOO CLOSE TO OVERFLOWING THE BUFFER *) 

BEGIN 

check:=tRue; 

if value<=leftpart then 

BEGIN 

ok:=false; check:=false; 

errorcno insertion to back over. *, nonfatal) ; prompt; 

GOTOXY(X,LINE) 

END 
ELSE 

if value>=therest-maxchar THEN 

BEGIN 

IF NOT WARNED THEN 
0E6IN 

ERROR( 'PLEASE FINISH UP THE INSERTION », NONFATAL > ; PROMPT; 
GOTOXYUtLlNE) ; 

warned: =true 
end; 
if value>therest-fudgf ctor then 



164* 15 211 h 143 :JE3Ifg 

lilt. ^ III 6 }1i LRR0RC6UFFER OVERFLOW MM', NONFATAL ) ; 

ill J- oji* 1?1 £XIT«I.MS£RTIT); 

l&^o la 2i:5 17b £Nj 

1647 15 <£l.*3 17b c-|\j a 

1648 15 21.-0 17b E i\id; 

1649 15 21U 138 

1650 15 22:d 1 PROCEDURE SPACEOVER; 

1652 15 lt% i ^r T ncwx^ R ?nteger; HANDLES SPACES AND TABS INSERTED int0 the buffer *> 

1653 15 22:0 SEGIN 

1*^ 11 ?. :1 ° IF CH=CHR(HT) THEN 

1d55 15 22:2 5 3EGI\I 

1656 15 22:3 5 NEwx:=x + i; 

1658 I? IV* 12 WI ™ PAGEZER0 DO 

1659 it Hit 35 SPWES-=liE2x-J 0PCNEWXaSNME) ^ (NEWX < SCR ^ NW IDT H ) DO NEWX:=NEWX + 1 ; 

1660 15 22:2 36 END 

1661 15 22:i 43 ELSE 

1662 15 22:2 45 SPACES:=l; 

\lll 11 WW * 9 IF CHECK(CURS0R+SP A CES) THEN 

1664 15 22:2 60 BEGIN 

ififift 11 WW 6 ° FlLLCHAR(EBUF-CCURSORD»SPACES,' »); 

111-, 11 W' 5 6B cursor:=cursor+spaces 

1667 15 22:2 69 END 

1668 15 22:0 75 END; 

1669 15 22:0 90 

111? 11 ^ 5:D 1 f ro ce:dure FIXUP; FORWARD; 

1671 15 23lj 1 

1672 15 2410 1 PROCEDURE ENDLINE; 

1674 It 24-D 1 ( * ^, RS n' lu THERE WAS N ° TEXT VERTED ON THE CURRENT LINE, THEN CONVERT 

1675 J5 24*D J ihr a F I5 E SPACES T ° BLANK IMPRESSION CODES. THEN INSERT AN <EOL> INTO 

itil it tl':o I Indentation! *) ^ BY ™ E APpR0PRIAT ^ number of SPACES FOR THE 

1677 15 24:0 BEGIN 

l*ll 11 IV' 1 ° WITH p AGE2ER0 DO 

1<=79 15 24:2 BEGIN 

168? J? llll ° IF N° T EXTYET THEN FIXUP; 

168? is tlW J EBUF-CCURS0R3:=CHR(E0L); , 

lb82 15 24.3 11 IF AUTOINDENT THLN GETLEADING 2 * 3 



244 



1683 15 24:3 IS, tlLst 

1684 15 24:1 ^i IF filling then 

lb85 15 24:5 eft BEGIN 

1686 15 24:6 26 GETLEADING; 

1687 15 2416 29 IF EBUF~C STUFFSTART J = CHR ( EOL ) THEN U EMPTY LINE *) 

1688 15 24:7 36 BLANKS : =PARAMARGIN 

1689 15 24:& 36 ELSE BLANKS : =LMARGIN 

1690 15 24:5 43 END 

1691 15 24:4 48 ELSE BLANKS:=05 

1692 15 24:3 53 IF CHECK ( CURSOR+BLANKS+1 ) THEN 

1693 15 24:4 64 BEGIN 

1694 15 24:5 64 FILLCHAR ( EBUF*[ CURSOR+1 3» BLANKS ♦ * •>! 

1695 15 24:5 72 CURSOR :=CURSOR+3LANKS+l 

1696 15 24:4 75 END; 

1697 15 24:3 79 NOTEXTYET : =TRUE 5 

1698 15 24:2 83 END! 

1699 15 24:0 83 END! 

1700 15 2«*:0 96 

1701 15 25:0 1 PROCEDURE BACKUP; 

1702 15 25:D 1 (* IF THE CH IS A BACKSPACE THEN DECREMENT CURSOR BY 1. IF THIS WOULD 

1703 15 25:D 1 RESULT IN BACKING OVER AN <EOL> OR A BLANK COMPRESSION CODE* THEN FALL 

1704 15 25ID 1 INTO THE CODE FOR A <DEL> (ALSO CHANGING THE CH TO <DEL> FOR COMMUNICATION 

1705 15 25:D 1 TO THE OUTER BLOCK) *) 

1706 is 25:d i var ptr: ptrtype; 

1707 15 25:0 BEGIN 

1708 15 2.5 :i IF CH=CHR(QC1) THEN 

1709 15 25:2 5 BEGIN GETLEADING; IF CHECK ( LINESTART ) THEN CURSOR:=LINESTART END 

1710 15 25:i 18 ELSE 

1711 15 25:2 20 IF <CH=CHR(BS>) AND 

1712 15 25:2 25 NOT< <EBUF*CCURSOR-23=CHR<DLE> > OR ( EBUF^CCURSOR-l 3=CHR ( EOD ) ) THEN 

1713 15 25:3 44 3E3IN 

1714 15 25:4 44 IF CURS0R<LEFTPART+2 THEN OK:=FALSE ELSE CURSOR :=CURS0R-1 5 

1715 15 25!3 64 END 

1716 15 25:2 64 ELSE 

1717 15 2513 66 BEGIN (* A <DEL> OR EQUIVALENT *) 

1718 15 25:4 66 CH : =CHR ( DEL ) ; (* TELL THE CRT DRIVER THAT THE LINE HAS CHANGED *) 

1719 15 25:4 71 GETLEADING; 

1720 15 25:4 74 IF CHECK (LINESTART-1 ) THEN CURSOR : =LINESTART-1 5 

1721 15 25:4 38 JOTEXTYET : =FALSE ; (* THANK YOU SHAWN! *) 

1722 15 25:3 92 E»0 

1723 15 ^5:0 92 END? 



1724 15 25 :c lu f + 

1725 la 23 :D 1 PROCEDURE FIXUP; 

172? fs 23- J ( * t2- V ^ T I HC INDEfJ TATlO!i SPACES INTO BLANK COMPRESSION CODES, AND MOVE 

'„: t* 5l''~ 1 THt C JR R ENT LINE AROUND ACCORDINGLY *) 

\fd6 lo 23: Q J 3EGIN 

w^n J- ft 10 ° ( * FIRST C ° M PRE:SS THt CURRENT LINE *) 

1731 J? ^ij 2 EB UF~CcuRSCR:i:=CHR<EOL>; (* FOOL GETLEADING *) 

1 l0 25.1 q. GlTLEAqiNG; 

1733 15 IV'l J IF «S Y J ES t J = 2 ™ EN l * ° K T ° PUT IN <0LE> * AS I 1 STANDS *) 

lilt 15 23U 23 E J° VELEFT(EBUFAC3TUFFSTART3 ^ 3U ^^INESTART + 2D,CURSOR-STUFFSTART) 

}IH ^ " :2 25 IF CHECK(CURS0R + 2-BYTES) THEN 

1737 nil j* a^i^r^^^r^i?^^^^r FFsTART+2 - BYTEs:icuRsoR - sTUFFsT « Ti 

17?2 1 = o 3!1 59 CURS0R:=CURS0R-(BYTES-2); 

17*0 15 till 7a E ^ BUFAC LINESTART::=CHR(DLE); EBUF-CLINESTART + 13:=CHR(32 + BLANKS) I 

1741 15 2310 90 

JtJI 15 26:d x procedure INSERTCH5 

nil 15 26«D J ( * Vll S ™ 0CEDURE INSERTS A SINGLE CHARACTER INTO THE BUFFER. IT ALSO 

1745 11 It'-n J DLES ALL 0F ^E CONTROL CODES <EOL,BS,DE L > AND BUFFER OVER- AND 

1746 15 tllo BEGIN ' C ° NDlTI0NS - ™SERTCH IS CALLED BY THE CRT HANDLER *> 

1747 15 26:i REPEAT 

llZl J' tt\t I 2h!=GETCH; ( * N ° ERR ° RS THAT INVALIDATE THE CURRENT CHARACTER HAVE OCCURED *) 

175? }? IV-l \\ l f MAPT OCOMMAND(CH)=LEFT then ch:=chr(bs); 

1752 is 26:1 59 BEGlN^' ^ CSP,HT * E0L ' BS ' DEL ' ET *' ES C ♦ DCl 3 THEN 

175? is IV'l II it < EI X> AN ° <ESC> ARE HANDLED IN THE BODY OF INSERTIT *) 

1755 is till 7I *[ S ° RD(CH) IN CSP.HT3 THEN SPACEOVER 

17S7 H IV.l ?6 IF ORO(CH)=EOL THEN ENDLINE 

1,J ' J. j co,b 81 ELSE 

"" W IVA 109 5 END IF 0RD(CH> ^ CDC1 ' BS ' DEL3 T ™ BACKUP. 

1760 15 26:2 109 ELSE 

1762 is IV-l iiJ BEG ^ ( * A CHARACTER TO INSERT! *> 

1763 is Hit HI i F F iSJEi^ET^HES^lwP,™" CH: = ' ? " " N ° "™' P «^™' CHARACTERS *> 
17^4 15 26.'4 130 IF CHECK(CURSOR + D AND OK THEN ~r>\ = 






1765 15 26:5 113 i EI 3 1 ^ 

1766 15 2616 143 UOTEXTYET : =FALSE « 

1767 13 26:6 147 EBUF^LCURSOR J:=CH; 
1766 15 26:6 151 CURSOR : =CURS0R+1 
1769 15 26:5 152 r N Q; 

177C 15 26:3 156 END; 

1771 15 26:1 156 UNTIL OK; 

1772 15 26:0 161 ENO; 
1772 15 26:0 176 

I77«t 15 27 ID 1 PROCEDURE POPDOWN; 

1775 15 27:D 1 (* DISPLAYS CONTEXT, DOING AN IMPLIED SCROLLUP IF NEC. *) 

1776 15 27:0 BEGIN 

1777 15 27:1 IF CLEARED THEN ERaSETOEOL ( X » LINE ) 

1778 15 2711 11 ELSE BEGIN CLEARED : =TRUE ; ERASEOS ( X» LINE ) END? 

1779 15 2751 29 GOTOXY ( R JUST , LINE ) ; 

1780 15 27!1 38 ERASETOEOL ( R JUST i LINE ) ; 

1781 15 27:i <47 WRITE ( CHR ( LF )) ; 

1782 15 27:i 55 IF LINE=SCREENHEIGHT THEN BEGIN EXITPROMPT: =TRUEl LINE :=SCREENHEIGHT-1 END? 

1783 15 27:i 72 WRITE( CONTEXT: EOLDIST ) ; 

1784 15 2711 87 FIRSTLlNE :=FALSE 5 <* SAYS THAT THE WHOLE SCREEN HAS BEEN AFFECTED. *) 

1785 15 27:0 91 END; 

1786 15 27:0 104 

1787 15 28:0 1 PROCEDURE WRITESP ( CH;CHAR ; HOWMANY: INTEGER ) ; 

1788 15 28:0 BEGIN 

1789 15 28:i IF X+HOWMANY<=SCREENWIDTH THEN WRITE( CHIHOWMANY ) ; 

1790 15 28:1 17 IF X+HOWMANY>=SCREENWIDTH THEN 

1791 15 28:2 26 BEGIN 

1792 15 28:3 26 GOTOXY { SCREENWIDTH, LINE ) 5 

1793 15 28:3 33 IF X+HOWMANY>SCREENWlDTH THEN 

1794 15 28:4 42 BEGIN WRITE(»! f >; GOTOXY ( SCREENWIDTH , LINE > END 

1795 15 28:2 57 END? 

1796 15 28.-1 57 X : =MIN ( SCREENWIDTH , X+HOWMANY ) 

1797 15 28:0 63 END; 

1798 15 28:0 84 

1799 15 29:D 1 PROCEDURE CLEANSCREENJ 

1800 15 29:D i (* CODE TO. IF POSSIBLE, ONLY ERASE THE LINE, OTHERWISE CLEAR 

1801 15 29:D 1 THE SCREEN. THEN CALL POPDOWN *) 
1302 15 23:0 BEGIN 

1803 15 29:1 3 firstline:=false; 

1804 15 29:i 4 IF CLEARED THEN 

1805 15 ?9I2 9 BEGI^ 



1307 1- 'HW ,? - IF X< S CRE£WWIDTH THEN tRASETOEQL ( X , LINE ) 

xbuo 15 29: A 25 ELSE 
1809 15 £9:2 27 SEGlM 



1810 15 *3\5 £7 



CLEAREO:=TRUE; ERASEOS < X t LINE ) 



i8ii 15 29:2 4c end; 

1812 15 29: 1 40 LINE:=LINE+Ii 

iAif i- iV 1 if8 IF LINE>SCREENHEIGHT THEN 

1811 is 29:2 55 3EGIM 

JfJ? " 29:3 55 line:=line-i; 

1816 lb 29:3 63 WRITELN! 

Jail J= ?« 13 69 EXiTPROMPT:=TRUE 

1816 lb 29:2 69 END? 

Jfl2n J5 Hll ?3 IF "^ISTOO THEN POPDOWN 

1820 15 29:o SO END; 

1821 15 29:0 91 

1822 15 30.*D 1 PROCEDURE POPOV; 

182^ ^ so^n J C * !?!! E !!! IN T "i LING M0DL ' THIS PR OCEDURE IS CALLED WHEN A LINE IS OVERFLOWED 

1825 II H'; D U J NEXT = lJne"™ ^ ™ E ^ IS SCANNE ° ° FF AN ° '' P0P ^D" DOWN TO THE 

1826 15 30:D 1 vAR 

\lll \l ln\i * "LENGTH: INTEGER! 

ifio« J« D 2 sa ve,ptr: ptrtype; 

1830 " 'Sic o BEG W ?N D: ^^ ^^ ^"^^ 0P ^HAR; 

JS^ JS IV 1 ° IF N OTEXTYET THEN F IXUP; 

1833 fa sSm J PTR:=M AX(SCAN(-MAXCHAR, = .-.,E3UF-CCURS0R-1D), 

JB3J IS 3 3 S;i ^ WLENGTH^C^R^f^" ' ' «^"URSOR-l 3, CURSOR , , 

1836 J? si! 3 si WI BEGIN GEZER ° ^ ^ WLENGTH>=RlV,ARG ™-LMARGIN THEN 

JS?I J 2 -n :<+ 58 WRITESP(CH,1); 

i2xo JS » ^ 62 EXiT(POPOV) 

1839 15 30:3 66 END; 

iflf J? ?nU &6 IF CH= '-' THEN WRITEC-M; 

la^J ,2 ?J:J 79 G ° T 0XY( X -WLENGTH + 1,LINE); 

lilt it ^J , 92 ERA SET0E0L<X-WLENGTH + 1,LINE,; 

ifll! is In:, J? b moverI ghT(ebuf-cptr:.ebuf-i:ptr + 3j,wlength); 

ialS 15 J" M0VELEFT(EBUF-CPTR + 3J, W 0RD,WLENGTH); 

J!?? J* 30:1 12<+ cursoR:=cursor+3; 

1840 15 30:i 129 E3UF-CPTR3:=CHR(EOL)« 247 
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1847 
1840 

ia<+y 

1850 
1851 
1852 
1853 
1854 
1855 
1856 
1857 
1858 
1859 
1360 
1861 
1862 
1863 
1864 
1865 
1866 
1867 
1868 
1869 
1870 
1871 
1872 
1873 
1874 
1875 
1876 
1877 
1873 
1879 
1880 
1881 
1882 
1883 
1884 
1885 
1866 
1887 



15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 
15 



30 

30 

30 

30, 

30, 

30 

30; 

30: 

30: 

30: 

30 

30 

30 

30! 

30 

30: 

30: 

30 

9; 

9: 
9; 
9; 
9; 
9; 
9; 
9: 
9; 
9: 
9: 
9: 
9: 
9 

9: 

9; 

9 

9; 

9: 

9: 

9: 

9 

9; 



133 

13 : ) 

144 

144 

147 

150 

153 

153 

156 

158 

163 

171 

173 

177 

196 

204 

204 

220 





3 

15 

23 

28 

30 

33 

36 

113 

116 

123 

128 

131 

143 

148 

151 

156 

161 

161 

153 

1G3 

185 



EBUF'* 

WITH 

3EG 

S 

C 

G 

C 

END 

ELSE 

BLA 
EBUF* 
CLEAN 

x:=bl 

GOTOX 

x:=x+ 

NOTEX 

end; 



CPT* + i:i:=CHR(DLE> « 
PAGEZERO 00 IF AUTOlNDENT 

i;j 

ave:=cursor; 

ursor:=ptr; 

etleading; 

ursor:=save 



THEN 



(* SET BLANKS TO THE INDENTATION OF THE LINE ABOVE *) 



NKS:=LMARGIN; 
CpTR+23:=CHR(BLANKS+32) ; 

screen; 

anks; 

Y(xtLiNE); write(word:wlength) ; 

wlength; 

tyet:=false 



begin (* insert *) 
cleareq:=false; 

EOLDISt:=SCAN(MAXCHAR.=CHR(EOL) iEBUF^CCURSORD) ; 
MOVELEfT(E3UF a CCURSORD.CONTEXTC0 3iEOLDIST); 

rjust:=screenwidth-eoldist; 

slamrIght; 

savebufcount:=bufcount; 

promptline:= 

• INSERT: TEXT C<BS> A CHAR,<DEL> A LINED C<ETX> ACCEPTS, <ESC> ESCAPES!!'; 

PROMPT; 

exitprqwpt:=false; needprompt:=true; 
leftpart:=cursor-i; 
notextyet:=false; 
findxY(x»line) ; gotoxy(X,line) ; 
erasetoeol(x,line) ; 
firstline:=true; 

if eoldistoo then (* a context needs to be displayed *) 
then (* and it will fit on the current line 



• • • 



*) 



BESIM 



IF RJUST>X 
IN 
0T0XY(RJUST,LINE) ; WRI TE < CONTEXTIEOLDIST > J GOTOXY (X« LINE > 

AND IT WON'T FIT ON THE CURRENT LINE *) 



END 
ELSE (* 
3E.SIN 



186S 


15 


9:4 


135 


1869 


15 


9:4 


1S8 


1390 


15 


9:4 


193 


1891 


15 


9:4 


199 


1892 


15 


9:5 


204 


1893 


15 


9:<+ 


212 


1394 


15 


9:3 


236 


1895 


15 


9:i 


236 


X396 


15 


9:2 


236 


1897 


15 


9:2 


238 


1898 


15 


9:3 


266 


1899 


15 


9:4 


266 


1900 


15 


9:5 


277 


1901 


15 


9:4 


311 


1902 


15 


9:5 


313 


1903 


15 


9:5 


320 


1904 


15 


9:6 


324 


1905 


15 


9:6 


337 


1906 


15 


9:4 


345 


1907 


15 


9:4 


360 


1908 


15 


9:4 


371 


1909 


15 


9:4 


374 


1910 


15 


9:5 


382 


1911 


15 


9:6 


382 


1912 


15 


9:6 


384 


1913 


15 


9:5 


389 


1914 


15 


9:3 


389 


1915 


15 


9:2 


389 


1916 


15 


9:3 


391 


1917 


15 


9:4 


391 


1918 


15 


9:5 


396 


1919 


15 


9:6 


396 


1920 


15 


9:6 


398 


1921 


15 


9:6 


401 


1922 


15 


9:5 


406 


1923 


15 


9:4 


406 


1924 


15 


9:5 


4C8 


1925 


15 


9:6 


415 


1926 


15 


9:7 


415 


1927 


15 


9:s 


420 


1928 


15 


9:9 


420 



firstline:=false; 

ERASEOS(XtLlNE);(* CLEAR THE SCREEN *) 
WRITELN; 

IF LINE=SCREENHEIGHT THEN 

BEGIN LINE:=SCREENHEIGHT-i; EXI TPROMPT ; =TRUE END; 

SOTOXY(RJUST,LINE+l); WRI TE ( CONTEXT : EOLDIST ) ; GOTOXY ( X, LINE) 
EN J ', 

REPEAT 

INSERTCH; 

IF NQT (ORD(CH) IN CEOL , ETX. ESC ♦DEL.DCl J) THEN 
BE3IN 

IF TRANSLATECCH3=LEFT THEN 

EL SE GIN IF X< = SCREENWIDTH THE 'M WRITE(CHR(BSPCE),» • .CHR(BSPCE) ) | X:=X-1 EN 

IF CH=CHR(HT) THEN WRITESPC •.SPACES) 
ELSE 

ELSE^RlTESP^CHan ^ ( X+1>=PAGEZER0 - RMAR GIN) THEN POPOV 

IF THEN Wr1tE(cSr(B^L)?; AND ( X=SCREE ^IDTH-8 , AND CCHOCHR(BS) ) 

IF (EOLDISTOO) AND 

(X>=RJUST) AND FIRSTLINE THEN (*RAN INTO CONTEXT *) 
BEGIN 

POPDOWN; 
GOTOXY(X,LlNE) 

end; 

END 

ELSE {* CH IN CE0L»ETXtESC.DELfDC13 *) 
BEGIN 

IF CH=CHR(E0L) THEN 
BEGIN 

cleanscreen? 

x:=blanks; 

gotoxy(x.line); 

END 
ELSE 

IF CH=CHR(DEL) THEN 
3EGIN 

IF arrTM <=1 THEN ( * RUBBED OUT ALL OF WHAT WAS ON THE SCREEN *) 

D t. b I N 

bufcount:=cursor+i; 2£§ 
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1929 


15 


9: 


1950 


15 


9: 


1931 


15 


9: 


1932 


15 


9: 


1933 


15 


s: 


1934 


15 


9: 


1935 


15 


9: 


1936 


15 


9: 


1937 


15 


9: 


1938 


15 


9: 


1939 


15 


9: 


1940 


15 


9: 


19<+1 


15 


9: 


1942 


15 


9: 


1943 


15 


9: 


1944 


15 


9: 


1945 


15 


9: 


1946 


15 


9: 


1947 


15 


9: 


1948 


15 


9: 


1949 


15 


9: 


1950 


15 


9: 


1951 


15 


9: 


1952 


15 


9: 


1953 


15 


9: 


1954 


15 


9: 


1955 


15 


3i: 


1956 


15 


si : 


1957 


15 


3i: 


1958 


15 


3i: 


1959 


15 


3i: 


1960 


15 


3i: 


1961 


15 


3i: 


1962 


15 


3i: 


1963 


15 


3i: 


1964 


15 


32: 


1965 


15 


32: 


1966 


15 


32: 


1967 


15 


32: 


1968 


15 


32: 


1969 


15 


32: 



42o 
429 
439 
445 
454 
454 
456 
464 
474 
477 
486 
491 
491 
493 
498 
498 
508 
511 
511 
524 
536 
539 
541 
556 
556 
556 
1 
1 
1 
5 

r 
O 

8 

10 

14 

17 

1 

3 

3 

3 

4 





E3UF"C CURSOR J :=CHR(EOL) ; 
CEwTERCURSOP.t LINE, MIDDLE, TRUE) ; 
IF EOLDISTOC THEN POPDOWN; 

IF EXITPROMPT THEN BEGIN PROMPT? EXITPROMPT :=FALSE END 
END 
ELSE 

begin gotqxy(0,line) ; cleared : =false \ 

lrasetoeol(oiline) ; line:=line-1 end? 
getleading5 
x:=blanks-bytes+cjrsor-linestart; 

GOTOXY(XtLINE) 

END 
ELSE 

IF CH=CHR(DC1) THEN 
BEGIN 

X:=0; GOTOXY(XfLINE) ! ERASETOEOL(X.LINE) 
END! 

end; 
until ch in cchr(etx) »chr(esc) d; 
if ch=chr(esc) then cursor : =leftpart+1 ; 
bufcqUmt:=savebufcount; 

WRAPUP; 

end; 



(*$TM O V E I T 



CURSOR MOVEMENT, PAGE. ADJUST, DELETE *) 



PROCEDURE MOVEIT; 
VAR 

scrollmark,x,line,i: integer; 

exitprompt: boolean; (* prompt after leaving moveit! *) 

oldline,oldx: integer; 

newdistiDIst: integer; 

doffscreen,atend,inreplace,indelete: boolean; 

ptr, anchor, oldcursor: ptrtype; 



procedure scrollup(3ottomline:ptrtype; howmany: 
(* BOTTOMLINE IS THE "LINESTART" of the line to 
VAR 

ptr: ptrtype; 
i: integer; 

BEGIN 



INTEGER) ! 
BE SCROLLED 



UP *) 



1970 

1971 

1972 

1973 

1974 

1975 

197& 

1977 

X978 

1979 

1980 

1981 
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1988 
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1990 

1991 

1992 

1993 

1994 

1995 
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1997 

1998 

1999 

2000 

2001 

2002 

2003 

2004 
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2009 
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15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 



32: u 
32:1 
32:1 
32:i 
32:2 

32:5 
32:5 

32:2 
32:1 
32:1 
32:1 
32:2 
32:2 
32:2 
32:2 
32:2 
32:1 
32:1 
32:0 
32:0 
33:d 
33:d 
34:d 
34:o 

34:1 
34:2 
34:3 
34:4 
34:5 
34:5 
34:4 
34:3 
34:4 
34:5 
34:5 

5 

4 

3 

2 

1 



34 
34 
34 
34 

34 



G 

1 

5 

1$ 

52 

32 

52 

53 

59 

62 

67 

67 

72 

62 

90 

98 

106 

117 



(* DISPLAY THE "-JEXT LINE ON THE: BOTTOM OF THE SCREEN *) 



34:2 



ptr:=scaN(maxchar 1= chr(eol),E3uf a i:lineiptrd)+lineiptr+i; 

WHILE (KHOWMANY) ANU ( PTROUFCOUNT ) DO 

BEGIN 

LINE1PTR:=PTR; PTR:=SCAN(V|AXCHAR,=CHR(EOL),EBUF-CPTR3)+PTR + i; 

I • — I + 1 

end; 
i: = o; 
gotoxy(0»screenheight) ; 

REPEAT 

BLANKS :=LEAD8LANKS(80TT0MLINE, BYTES) : 
WRITE(CHR(LF))? 

LINEOUT (BOTTOMLlNEt BYTES* BLANKS, SCREENHEIGHT)? 

line:=line-i; 

UNTIL (I>=HOWMANY) OR < BOTTOMLINE>=BUFcOUNT-l ) : 

EXITPR0MPT:=TRUE? 
121 END(* SCROLLUP *) ; 
138 

1 PROCEDURE CLEAR(X1,Y1,X2,Y2: INTEGER); FORWARD? 
5 

1 PROCEDURE CENTER; 
BEGIN 

IF INDELETE THEN 
BEGIN 

IF LINE>=SCREENHEIGHT THEN 
3EGIN 

CENTERCURS0R(LINE,2,TRUE) ; 

€N Q F ABS{CURS0R - ANCHOR) > ABS(DIST) THEN CLEARC . 1 .MAX (X-l ,0 ) .LINE) 

ELSE 
BEGIN 

CENTERCURSOR < LINE. SCREENHEIGHT-1, TRUE): 
GOTOXY(X.LINE) ; 

IF ABS(CURSOR-ANCHOR) > ABS(OIST) THEN WRITE ( CHR ( 11 ) ) 

END ; 

doffscreen:=true; 

END 
ELSE 

IF ICOMMANDrPARAC) AND (( DIRECTION •<» , OR (LINE MOD SCREENHEIGHT=OLDLINE ) ) 



5 
5 
12 
12 
20 
49 
51 
53 
53 
63 
72 
93 
93 
97 
97 
99 



251 



253 



SOU 15 54:2 lib THt.h Ci>TERCURsOR(LINEiOLDLINE»TRUE) 

2012 16 5112. 12-5 FLSE C~NTERCURsOR ( LINE » MIDDLE , TRUE ) ; 

2015 15 34:1 mo IF EXlTPRO'^PT AND ( COMMANDOGl'JI TC ) THEN 

2014 15 34:2 149 BEGIN 

2015 15 3413 149 PROMPT; EXITPRQMPT : =FALSE 

2016 15 34:2 152 END! 

2017 15 34:1 156 OLDLlNr : =LINE 5 OLDx:=X; 

2016 15 34:0 163 enc; 

2019 15 34:0 liiO 

2020 15 35:D 1 PROCEDURE UPMOVE; 

2021 15 35:D 1 VAR I:iNTEGER; 

2022 15 35:0 EEGIN 

2023 15 35:i i:=l; 

2024 15 3511 3 GETLEADING; 

2025 15 35:i 6 (* FIND THE LINE FIRST *) 

2026 15 35:i 6 WHILE ( K = REPEATFACTOR ) AND ( LINESTART>1 ) DO 

2027 15 35:2 15 BEGIN 

2028 15 35:3 15 CURSOR :=LINESTART-1 ? (* LAST CHAR OF LINE ABOVE *) 

2029 15 35:3 20 GETLEADING; 

2030 15 35:3 23 LlMEI =LINE-1 ! i:=I+l; 

2031 15 35:2 36 END? 

2032 15 3552 38 (* IF POSSIBLE SET THE CURSOR AT THE SAME X COORD WE CAME FROM. OTHERWISE, 

2033 15 3552 38 SET IT EITHER TO THE BEGINNING OF THE BUFFER, THE BEGINNING OF TEXT 

2034 15 35:2 38 ON THAT LINE, OR THE END OF THE TEXT ON THAT LINE *) 

2035 15 35:i 38 CURSOR:= 

2036 15 35:i 3S MAXU, <* THE BEGINNING OF THE BUFFER *) 

2037 15 35:i 39 MAX ( STUFFSTART, (* THE BEGINNING OF THE TEXT *) 

2038 15 3551 40 MIN ( X-BLANKS+BYTES+LINESTART, (* SAME COL *) 

2039 15 35:i 49 SCAN ( MAXCHAR , =CHR ( EOL ) , EBUF A CCURSOR3 ) +CURSOR (* EOL *) 

2040 15 3511 59 ) 

2041 15 35:1 61 ) 

2042 15 35:i 66 ); 

2043 15 35:i 78 IF LINEXl THEN CENTER; 

2044 15 35:0 87 END(* UPALlNE *)i 

2045 15 35:0 102 

2046 15 36:D 1 PROCEDURE DOWNMOVE; 

2047 15 36:D 1 vAR 

2043 15 36:0 1 I: INTEGER; 

^049 15 36:D 2 NEXTEO L : PTRTYPE! 

2050 15 36:0 3EGIN 

2051 15 T6:i i:=l; 



2oU 15 3b:'2 28 *HlLE i (NEXTEOL<aJFCOUNT-l) AND ( I<=REPEATFACT0R , DO 

2355 15 36:3 2d CURSOR ' = NEXTEO|_ + l ' 

^^ ip 3 Q. #i + 52 3 «r g I N 

<i059 lo 36:5 52 '~LIMF • -LI,Mr*i : 

2060 15 36.'5 60 l: = I + lV 

20°62 is till 74 lF g LINE = SCREENHEIGH T + l THEN 

20°" is Itll 7 7 a scroll M ark:=cursor; 

2065 15 36:* 78 ZHOl 

2066 15 36:2 78 END; 

2068 \\ til] 6 ° IF '- It ^>SCREENHElGHT THEN 

2069 Jo 36:1 100 lF ^^^- S "^NHEi e HT> = SCREENHEIGHT, OR (INDELETE, THEN 

2070 15 36:2 100 ELSE 

20°72 " till HI GET J A C ^^f^"OLLMARK,UINE-SCREENHElGHT); 

2 2 7' is 3 3 6;i ii? " SET P ?rEITHER S S T n T yHE^ U ^°nc A ^J H a E llr SAME X C °° RD WE C <^ FROM. OTHERWISE, 

2075 15 36.-1 U7 ON \JaT L^r lo TMr nl J HE 3UFFER ' ™E BEGINNING OF TEXT 

2076 15 36: 1 117 r U R nV L , ^n, R T E END ° F THE TEXT 0N THAT L ™E *> 

2077 15 36. : 1 ipo CURS0R ; = M ™ (BUF COUNT-l , <* END OF THE BUFFER *, 

2078 15 3611 121 ( S;^ FSTART ' { * N ° T IN THE = INDENTATION *) 

2079 15 36:i 1 23 WIN ( X-BLANKS+BYTES+LINESTART (* WHERE IT WANTS TO BE *> 

2080 15 3&:i i^o ; SCAN < MAX CHAR,=CHR(E0L).E3UF-CCURS0RD)+CURS0R 

2081 15 36:i 142 s 
2032 15 36:1 1*7 ,. 

fntt ^l IV ° 159 END( * D°WNMOVE *); 

208* 15 36:0 174 

20?! \l III l pR0CE dure leftmove; 

2086 lb 37:0 BEGIN 

2088 7 It 37M S Sut^ ADI ^ : ( * SET LIN "TART AND STUFFSTART •) 

2089 15 37J2 14 WH ^ ( STUFFSTART> C URSOR-REPEATFACTOR , AND ( CURSOR>REPEATFACTOR , DO 

till is %\l H IF^B^U^ <* CHARS MOVED OVER *> 

2092 15 37'^ 7= :;, l „" llukborj-chr(eol) then cursor : =cursor-l ; 

* 5 35 CUrsOR: =^^ s can(- M axchar,=chr(eol,,ebuf-ccurs5r:) + cursor,d; ,,4 

<W vj «J 



2093 


15 


37:3 


5 a 


^094 


15 


37:3 


64 


*0 95 


15 


37:2 


o7 


20 96 


15 


37:1 


b9 


2097 


15 


37:i 


36 


2096 


15 


37 :i 


95 


2 99 


lb 


57 :o 


104 


2100 


15 


37:0 


113 


2101 


15 


33:0 


1 


2102 


15 


38!D 


1 


2103 


15 


38 :o 


1 


2104 


15 


38:o 





2105 


15 


38:i 





2106 


15 


38:i 


14 


2107 


15 


38:2 


27 


2106 


15 


38:3 


27 


2109 


15 


38!3 


36 


2110 


15 


38!3 


41 


2111 


15 


38:3 


44 


2112 


15 


38:3 


47 


2113 


15 


38:3 


55 


2114 


15 


38:3 


68 


2115 


15 


38:2 


78 


2116 


15 


38:i 


84 


2117 


15 


3812 


91 


2118 


15 


38:3 


104 


2119 


15 


38:2 


104 


2120 


15 


38:3 


108 


2121 


15 


38:i 


118 


2122 


15 


38 :i 


131 


2123 


15 


38 :o 


140 


2124 


15 


38:o 


154 


2125 


15 


39:d 


1 


2126 


15 


39:d 


2 


2127 


15 


39:0 





2128 


15 


39:1 





2129 


15 


39 :i 


3 


2130 


15 


39:2 


8 


2131 


15 


3913 


5 


2132 


15 


39:4 


17 


2133 


15 


"*9:5 


17 



3J4 



LrjE.:=LiNE-i; 

setleaqing: <* reset llnestart and stuffstart *) 
end; 

CURS0R:=MAX(5TUFFSTAKT«MAX(CURS0R-REPEATFACT0R«1) ) ; 
IF LINFXl THEN CENTER; 
FINDXY(X.LINE) 5 
END (* LEFT^IOVE *) 5 

PROCEDURE RIGHTMOVE; 
VAR 

eolptr: ptrtype; 

BEGIN 

EOLPTR : =SC AN ( MAXCHAR »=CHR < EOL) ♦ E3UF~C CURSOR 1 )+CURSOR! 

WHILE (E0LPTR<CUR30R+REPEATFACT0R) AND ( EOLPTR<BUFCOUNT-l ) DO 

BEGIN 

repeatfactor:=repeatfactor-(eolptr-cursor+d ; 

cursor:=eolptr+i; (* beginning of the line below *) 

getleaoingj 

cursor:=stuffstart; 

line:=line+i; 

if line=screenheight+1 then scrollmark : =linestart ; 

EOlPTR:=SCAN(MAXCHAR»=CHR(EOL)iEBUF*CCURSOR3)+CURSOR 

end; 
if line>screenheight then 

IF (LINE-SCREENHEIGHT>=SCREENHEIGHT) OR (INDELETE) then 

center 

ELSE 

SC^OLLUP( SCROLLMARK, LINE-SCREENHEIGHT) ; 
CURSOR :=^IIN(BUFCOUNT-l»CURSOR + REPEATFACTOR) ; 
FINDXY(XiLINE) ? 

end(* rightmqve *) ; 

procedure llnemove(repeatfactor: integer); 
var i: integer; 

cjEGIN 

i:=i; 

IF DIRECTION=»<' THEN 
BEGlM 

WHILE (K = REPEATFACTOR) AND (CURS0R>1) DO 
BEGIN 

IF EBUF /N CCURSORJ=CHf -QL) THEN CURSOR t=CURSOR-l ; (* NULL LINE SE *) 



?135 11 5-5 H CUHSOR:=SCaN(-HAXCHAR.=CHR(E0L).E9UF*CCURSORJ)+CURS0RI <* 1 UP *) 

2136 15 ii'-Z t 1F CUrtS0R > = l T HEN BEGIN LINE : =LINE-1 ! 11 = 1 + 1 END; 

c-ljo 13 w-3.4- 2 ENDS 

^138 in IV-i tt CuisOR:=MAX(l, CURSOR); (* 3ACK INTO REALITY *) 

:;;* ^ ?*•- ' 3 ate.md:= (cursor=d; 

::: " f! :i 79 if 7 line<i then clnter 

21«f0 lb 39:2 fio END 

2i<u 15 39:1 as else 

pjjf Jr ^! :2 90 BEGlfJ (* DIRECTI0N=»>» *) 

HI* 15 39^ 10J WHILE (KrREPEATFACTOR) AND ( CURS0R<BUFC0UNT-1 ) DO 

"Is " 3?l5 117 3E 5^?S3lSS<SuR?SS5? A ?H-5 HR f E0L » ' EBUR-C CURSOR 3 » ^CURSOR^X . <*1D0WN*> 

l\ll 11 t 3:S 122 BEGIN 

till J? q 9:7 122 i: = i+i; line:=line + i; 

2150 15 3?!I ins , IF LI NE=SCREENHEIGHT + 1 THEN SCROLLMARK: rCURSOR ; 

2151 15 39J4 m 8 END;^ 

:,^ 2 J^ !! :3 15 ° atend:= (cursor>=bufcount-d ; 

tilu ik Ja 158 IF LINE>SCREENHEIGHT THEN 

2155 is ^u i 1 ^ IF (LINE - SCR EENHEIGHT> = SCREENHEIGHT) OR 

till IS tilt ,1. inreplace OR (CON!MAND=PARAC) or indelete 

' 13b 13 -59. V 180 THEN 

2157 15 39:5 186 CENTER 

2158 15 39:4 166 EL SE 

2160 is ?q.^ o™ "" SCROLLUP(SCROLLMARK,LINE-SCREENHEIGHT); 

*:* " , 3 20 ° cursor:=min(Cursor,bufcount-i) 

2161 15 39:2 204 END! 

2162 15 3911 211 GETLEADlNG; 

till 15 till 111 X'=BLAnksI UFFSTART: ** ^^ T0 BEGINNING 0F STUFF •) 

2165 15 3910 221 END(* LlNEMOVE *); 

2166 15 39:0 238 

2167 15 <+0:D 1 PROCEDURE JUMPBEGIN; 

2168 15 <+0:0 BEGIN 

t\il JS aSii ° cur sor:=i; CENTERCURSOR(TKASH,l, FALSE) 

difo is 4o:o 8 end; 

2171 15 <+0:0 2<+ 

2172 15 m:o 1 PROCEDURE JUMPEND; 

2173 15 m:o o begin 

2174 15 4i:i CURS0R:=3UFC0UNT-lj CENTERCURSOR ( TRASH, SCREENHEIGHT , FALSE ) 2 ^ 






2175 15 m:a 10 end; 

2176 15 41:g <?6 

2177 lb 42:D 1 PROCEDURE ADJUSTING; 
^173 15 42:0 1 LABEL 15 

2179 15 42:D 1 TYPE 

2180 15 42:0 1 MODES=(RELATIVEtLEFTJ»RlGHTjt CENTER) ! 
2131 15 42:D 1 VAR 

2182 15 42:0 1 LLENGT-),TDELTA,I: INTEGER; 

2183 15 42:0 4 SAVEDlR: CHAR; 

2184 15 42:D b MODE: "IQDESi 
2165 15 425D 6 

2186 15 43ID 1 PROCEDURE DOIT (DELTA: INTEGER ) ; 

2187 15 43:D 2 VAR 

2188 15 43ID 2 EOLDIST! INTEGER? 

2189 15 43ID 3 TI PACKED ARRAY C . .MAXSTRING3 OF CHAR; 

2190 15 43:0 bEGIN 

2191 15 f3:i GETLEADING; (* SET LINESTART. STUFFSTART. AND BLANKS *) 

2192 15 4311 3 IF BLANKS + OELTA<0 THEN DELTA: =-BLANKS ! 

2193 15 43:i 14 IF { EBJF'CLINESTART D=CHR < DLE) ) AND ( STUFFSTART-LINESTART=2) THEN 

2194 15 43:2 27 X:=0RD(EBUF~CLlNESTART + i:i)+DELTA-32 

2195 15 43:i 34 ELSE 

2196 15 43:2 41 BEGIN 

2197 15 43:3 41 IF STUFFSTART-LINESTART>2 THEN 

2193 15 43:4 48 MOVELEFT < EBUF^STUFFSTARTD. EBUF~[:LINESTART+2D,BUFC0UNT-STUFFSTART ) 

2199 15 43:3 59 ELSE 

2200 15 43:4 61 BEGIN 

2201 15 43:5 61 IF BUFCOUNT>BUFSIZE-100 THEN 

2202 15 43!6 68 BEGIN 

2203 15 43!7 68 ERROR( 'BUFFER OVERFLOW • .NONFATAL) J 

2204 15 43:7 90 EXIT < ADJUSTING ) 

2205 15 43:6 94 END 

2206 15 43:5 94 ELSE 

2207 15 43:6 96 MOVERIGHT ( EBUF'C STUFFSTART 3 . EBUF ,S CLINESTART + 23.BUFC0UNT-STUFFSTART ) ; 
2206 15 43:4 107 END; 

2209 15 43:3 107 IF LlNESTART+2<>STUFFSTART THEN 

2210 15 43:4 114 3EGIN 

2211 15 43:5 114 READJUST ( LINESTART ♦ LlNESTART+2-STUFFSTART ) ; 

2212 15 43:5 123 5UFC0UNT I =BUFCOUNT+Ll NESTART+2-STUFFSTART ; 

2213 15 4314 132 END; 

2214 15 43:3 132 EBiJF*C LINESTART 3 : =CHR < DLE ) ; 

2215 15 43:3 136 X : =3LA,\|KS + OELTA ! 



mode:=relative; 
showcursor; 

FlNDXY(X,LINE) ; 



2216 15 <45:2 ma Ef , D; 

"II I 5 a?'' 1 ^ E3UF-C L I.-ylESTART + U:=CHR(X + 3£); 

-219 i? a*-! I 52 CURSOR:=LlfJESTART + £; GETLEADIMG; 

2220 15 M \%l f Q rl?-nu l ° ,L r LNE)i ER ASLTOLOL ( . LI^E ) ; (* ERASE THE LINE *) 

2221 15 till Ht , W D * NL 0^ L i)' START,BYTES ' BLANKS ' LINU; GOTOXYIX. LINE); 

2222 15 4310 206 " 

f"? J 5 £f2:0 ° SEGIfj (* ADJUSTING *) 

2225 It IVA I W ITH g PAGEZERO DO 

2^27 « till iS INREPLACE?-?R E Se T ' UN? EXlTPR0MPT: =F ^ SE ' INDELETE:=FALSE , LASTPA T :=CURSOR , 

2229 J5 IV' 5 lB pRo,mptline: = 

2231 is lE iSi ' AD ^pt; ( Sr R omp^ <left, R ight,up.do W n-a RR ows> c<etx> to leaved. 

2232 15 42*3 in 

2233 15 42:3 114 

ll\X 11 IV' 5 123 tBelta.^oT 

2235 15 42:3 126 REPEAT 

2237 11 If 126 ch:=getch; 

223a J? :I J, 3 ? command:=maptocommand<ch>; 

ll\t ll aV'.^ m infinity:=false; 

224n It ll'-t J! 5 IF c OMMAND=SLASHC THEN 

^<240 15 42:5 150 BEGIN 

2242 ^ 42.'5 "S REPEATFACTOR : =1 ; INFINITY: =T RU E ; CH:=GETCH, COMMAND:=TRANSLATECCHD 

2243 15 42|4 173 EL s E 

2245 J5 42-a 111 IF . COMMAND=DlGIT THEN REPEATFACTOR : =GETNUM ELSE REPEATFACTOR -1 5 

2246 IX llll Itf IF C0M MAND IN CUP.DOWN3 THEN FACTO* .-1 , 
tcto i3 't^.b 204 BEGIN 

224^ ^ ll\l 2?7 IF_COMMAND=UP THEN DIRECTION: = •< . ELSE DIRECTION:=*>* ; 

2249 15 42:6 220 ATEND • =FflL SF • 

2251 15 42:7 238 WH !^ T J 0T ATEND AND << K=REPEATFACTO R ) OR INFINITY) DO 

2252 15 42:8 233 I'=I + i; 

till 11 121 HI LIN^VECl,, 

2255 i^ ; 2 M ^ IF NOT ATEND THEN 

2256 15 4?*n ok 5 UtGlN or--, 

,0 t52 IF MODE = RELATIVE THEN DOIT(TDELTA) 2lj7 



2'53 



2257 


15 


42:0 


258 


2258 


15 


42:1 


262 


2259 


15 


42:2 


262 


2260 


15 


42:2 


274 


2261 


15 


42:2 


277 


2262 


15 


42:2 


236 


2263 


15 


42:2 


299 


2261+ 


15 


42:3 


299 


2265 


15 


42:2 


318 


2266 


15 


42:1 


336 


2267 


15 


42:9 


336 


2268 


15 


42:7 


336 


2269 


15 


42!5 


336 


2270 


15 


42:4 


338 


2271 


15 


42:5 


340 


2272 


15 


42:6 


345 


2273 


15 


42:7 


345 


227*+ 


15 


42:6 


354 


2275 


15 


4215 


357 


2276 


15 


42:6 


359 


2277 


15 


42:7 


364 


2278 


15 


42:6 


364 


2279 


15 


42:7 


372 


2280 


15 


42:6 


375 


2281 


15 


42:7 


377 


2282 


15 


42:8 


385 


2283 


15 


42:9 


385 


2284 


15 


42:9 


383 


2285 


15 


42:9 


400 


2286 


15 


42:0 


405 


2287 


15 


42:9 


415 


2288 


15 


42:0 


417 


2289 


15 


42:1 


422 


2290 


15 


42:0 


436 


2291 


15 


42:1 


438 


2292 


15 


42:2 


438 


2293 


15 


42:2 


441 


2294 


15 


42:1 


460 


2295 


15 


42:8 


462 


2296 


15 


42:7 


462 


2297 


15 


•12:8 


464 



else 

bfc-GIN 

llength:=scan(maxchar,=chr<eol) iEBUF^cstuffstartj) ; 

case mo0e of 
leftj: doit(lmargin-blanks) 5 
rightj: dqit( (rmargin-llength+u-blanks) ; 

CFNTER * 

D0IT(((RMARGIN-LMARGIN+1)-LLENGTH> DIV 2-BLANKS+LMARGIN ] 

END (* CASE *) 
END (* ELSE *) 
END? <* IF NOT ATEND *) 
END (* WHILE ... *) 

END 
ELSE 

IF COMMAND=LEFT THEN 

BE DOIT(-REPEATFACTOR) ! TDELTA:=TDELTA-REPEATFACTOR ; MODE:=RELATIVE 

END 
ELSE 

IF command=right THEN 
BE doit(REPeatfactor) ; tdelta:=tdelta+repeatfactor ; mode:=relative 

END 
ELSE 

IF COMMAND IN C LISTC . REPLACEC » COPYC D THEN 

BEGIN 

getleading; 

llength:=scan<maxchar«=chr(eod .ebuf*cstuffstartd> 5 

if c0mmand=listc then 

BEGIN MODE:=LEFTJ; DOIT(LMARGIN-BLANKS) end 

ELSE 

IF COMMAND=REPLACEC THEN 

BEGIN MODE:=RIGHTJ; D0IT((RMARGIN-LLENGTH+1)-BLANKS) END 

ELSE (* COM^AND=COPYC *) 
BEGIN 

DOlTtURMARGIN-LMARGIN + U-LLENGTH) DIV 2-BLANKS + LMARGIN) 

END 

END 

IF CHOCHR(ETX) T* ' BEGIN ERRWAIT! SHOWCURSOR END; 



oil l l d '* 47? i: ^' Tl l- CH = CHK(ETX>: 

<-29^ lb H2:3 '464 Dl.<ECTION:=SAy/rDIR; 

2300 15 12:2 ^7 eimo; 

2301 15 42IU 487 END; 

2302 15 4210 5u6 

2303 15 44tD 1 PROCEDURE TA33Y! 

230°5 " IVll \ VAR SCAN aL0 " 5 ™ E LINE UNTIL Y ° U EITHER HIT A TA8ST0P 0R THE ^D OF THE LINE *> 

"S5 J! !7 :0 1 NE.WX.ENDX, I, NUMTOOO: INTEGER; 

2307 15 44:0 3EGIN 

2308 15 44.-1 NUMTODO:=REPEATFACTOR? 

'Vlt f b 4J+:i 3 F0R i:=1 To NUMTODO DO 

^310 15 44:2 14 BEGIFM 

2311 15 44:3 14 repeatfactor:=i; 

«" ii IIJ3 28 nLx*-x; TI °" =,> ' ™ EN RIGH ™ 0VE ELSE leftmove; 

ll l ,t II l+£f:3 33 with'pagezero do 

2315 15 44:4 33 BEGIN 

:::* H ^ :s 33 if direction=«>» then 

2317 15 44:6 38 BEGIN 

2319 15 44- : t It ENDX:=SCANCMAXCHAR,=CHR(E0L),EBUF-CCURS0R3)+XI 

2320 15 It'll 77 END HILE ( TABST0PCNE:WX:,=N0NE > AND (NEWX<ENDX) DO NEWX:=NEWX + 1 ; 

2321 15 44:5 77 nSE 

2322 15 44: 6 79 BEGIN 

llll 15 IV' 1 ?9 getleading; 

2325 15 44il J5 twl^ ( TA3ST0PCNEWX 3 = N0NE > AND < NEWX>BLANKS) DO NEWX:=NEWX-1 ; 

l\ly \l IV.l 105 REPEATFACTOR:=ABS(NEWX-X); 

llll It tl\l HI EN ^ ?r5lJJ°^ ,> ' THEN RIGH ™ 0VE ELSE "-EFTNOVE, 

2329 15 44.-2 124 END {* FOR *) 

2330 15 44:o 124 END; 

2331 15 44:0 150 

2332 15 45:D 1 PROCEDURE MOVING; 

2333 15 45:D 1 vAR 

2334 15 45.-D 1 SAVEX: INTEGERS 

2335 15 45:0 BEGIN 

2336 15 45:1 indelete:=false; 

llll \l " 5:1 ** inrepuce:=false; 

2338 15 45:i 9 EXITPR0MPT:=FALSE; P59 
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15 
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IF DIRECTION=»<» THEN JUMPBEGIN ELSE JUMPEND 



LEFTMOVE ELSE RIGHTMOVE; 



IF INFINITY THEN 
BEGIN 

CASE. COMMAND OF 

up, left: jumpbegin; 

DOWN* RIGHT: JUMPEND; 
^ARACt SPACE, ADVANCE, TAB: 

END; 

meedpro«pt:=true! 

NEXTCOMMANDi 
EXIT(MOVEIT) 

end; 
findxy(x«line) ; 

REPEAT 

oldx:=x; oldline:=line; 
case command of 

LEFT: LEFTMOVE; 

right: rightmove? 

space: if directions^ 1 then 

up: upmovei 

domn: downmove; 

advance: linemove(repeatfactor) ; 

parac : 
if repeatfactor>1000 then error* 'too many* tnonfatal ) 
else linemo\/e(screenheight*repeatfactor) i 

TA3: TABBY 

end; 

if exitprompt or ( command=parac ) then 
gotoxy(x,line) 

ELSE 

IF LlNE=OLDLINE THEN 
BEGIN 

IF X=OLDX+l THEN CONTROL(FS) ELSE IF X=OLDX-l THEN 
ELSE GOTOXY(X,LINE) 
END 
ELSE 

IF X=OLDX THEN 
3EGIN 

IF LINE=0LDLINE+1 THEN 
ELSE IF LINE=0LDLINE-1 
ELSE G0T0XY(X,LINE) ! 
END 



WRITE(CHRCBSPCE)) 



niRlTE(CHR(LF) ) 
THEN CONTROL(US) 
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GOTOXYUiLlNE) ; 

repeatfactor:=i; 
nextco^mand 

UNTIL "NOT (COMVIANO IN CUP. DOrfN, LEFT, RIGHT. ADVANCE. SPACE. TABU) • 
IF EXITPROMPT THEN PROMPT; "uvhnlc.^au , TAB J) , 

SHOWCURSOR; 

END (* WovING *) ; 

PROCEDURE PUTITBACK(C1.C2: PTRTYPE); 
VAR 

PTR: PTRTYPEJ 

INDENT, LOFF: INTEGER? 
BEGIN 

PTR:=Cl; 

WHILE PTR<=C2 DO 
BEGIN 

IF EBUF A CPTR3=CHR(E0L) THEN 
BEGIN 

ptr:=ptr+1; writeln; 
indent:=leadblanks(ptr,loff> ; 
if (ptr<c2) and undent>0) then 

writec 'undent); 
ptr.*=ptr+loff 

END 

ELSE 

^3EGIN WRITE(EBUF«CPTR3); PTR:=PTR+1 END? 
END 5 

end; 

PROCEDURE CLEAR(*Xl fY l.X2,Y2: INTEGER*); 

(* SCREEN CO-ORDINATE (XI, YD IS ASSUMED TO BE BEFORE (X2.Y2) THIS 

T P 5 E oe l2^N T S E K ?S EE T?S E S°:?!c D ;!Js A ^, AN 2, et " RS (WR "" ""«>«« 

VAR XX, I: INTEGER; 
3EGIN 

GOTOXY(Xl.Yl) ; 

xx : =xi • 

Crisis ^r^-.i^o n ^ > sj? E E :. ER ? sEToEoL,xx - i,i x * : =°« ««™-" *»• 

else for i:=xi to x2 do writec n 2G1 
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end; 

procedure resqlvescreen; 

VAR 

Xl,X2iYltY2«SAVE: INTEGER; 
CltC2: PTRTYPE! 

BEGIN 

xi:=x; yi:=line; 
x2:=oli)x; y2:=oldline; 
if new0ist>dist then 
begin ci:=cursor-i; c2:=oldcursor; xi:=xi-i end 

ELSE 

if newoist<oist then 
begin c2:=oldcursor-i; ci:=cursor; x2:=x2-i end 

ELSE 

EXIT(RESOLVESCREEN) ; 
IF (Y1>Y2) OR <CY1=Y2) AND (X1>X2>> THEN 
BEGIN 

save:=ci; 
save:=yi; 
save:=xi; 
end; 
if abs(newdist)>abs(dist) then 

CLEAR(Xl«Yl«X2tY2) 

ELSE 
BEGIN 

GOTOXY(Xl.Yl) ; 
PUTITBACK(C1»C2) 
END! 
GOTOXY(XtLINE) 

end; 

procedure deleting: 

LABEL 1; 
VAR 

ATBOLtANCHORiSAVE: PTRTYPE5 

ok,atbqt»nomove: boolean; 
startline: INTEGER; 

BEGIN 

ooffscreen:=false; indelete; 



ci:=C2; C2:=save; 
yi:=Y2; Y2:=save; 
xi:=x2; X2:=save 



'rue; inreplace:=false; exitprompt:=false 



ittl II Ism - a ^hor:=cursoh; u E wD1st:=o; 

246. is 4.m ^ ?rJ^?. :, i i !J?!/ T30l:=line:starT8 atbot: = (cursor=stuffstart); 

.467 lo <*8:i 113 SHOWCURSOR; 

24 o3 15 48:1 U6 FINDXY(X.LINE)' 



2469 15 H8:i 125 



staktline:=line; 



2470 la <f8:i 13Q REPEAT 

llll il ,?! :2 i3 ° 3ldcursor:=cursor; 

till 1 J? 1 ? 13i+ DIST;=NEWDIST; 

Ull \l 48-2 ISP r° LDX:=X; OLDLINE:=LIN E l 

<=Tft la ho. 2 152 ch:=getch; 

2476 15 ua. : p ill command:=translatecch3; 

2477 15 J--; Hi 11 COMMANDrDIGIT THEN REPEATFACTOR:=GETNUM ELSE REPEATFACT0R--1 • 

2478 15 48:1 HI F B EGIN AND ™ CREVERSEC ' ' DIGIT ' ADVANCE. SPACED THEN PZ * 1F * CT0R - l < 

llll \l IV.u HI CASE C0MMAN ° OF 

till it 11 u III LEFT: leftmove; 

till \l H:l RIGHT: "SHTN0VE1 

2483 Is ll\l HI up" C up M ow. DIRE:CTI0N=,<, THEN LEFTM0VE ELSE RIghtmove; 

lilt is 5 H'l 111 oo^fEiovE; 

2486 15 is' J III ADVANCE: LINLMOVE < REPEATFACTOR, ; 

2487 is all* III REVERSECFORWAROC: 

2488 is u« 3ZG1H 

2489 is 4A-7 ill lF COMMAND=REVERSEC THEN 

2490 is 5 H\l HI direction: = .<. 

till is 11- til direction: = om 

2493 15 48. : 5 268 run?™**' ° ' ° ' ' WRITE < ^^CTION) ; GOT XY(X,LINE) 

lilt it mi 27 ° taI? tabby 

2495 15 48:4 270 EN D; 

2W is JJI1 l°,l newoist:=cursor-anchori 

24S8 7 J' IJiJ III gtSOLVESCREEN. 

2499 15 48:2 312 ELSE 

2sS? is "gij ^ IF (CHOCHR(ESO) AND ( CHOCHR ( ETX) , THEN 

2502 is ll'-i Itl IIMTT 3ESIN ERRWA IT! GOTOXY(X.LINE) END opo 

ID <+8.1 339 UNTIL (Cri IN C CHR < E TX ) , C HR < E SC ) D ) ; 2G3 



o 



04 



2503 15 48:1 352 IF CH = CHR(tTX) THZiJ 

2d04 15 43:2 359 dlSIm 

2505 15 4813 359 GETLEADING! (* INDENTATION FIXUP *) 

2506 15 48:3 362 IF ATBOT AND ( CURSOR=STUFFSTART ) THEN 

2507 15 48:4 369 BEGIN CURSOR : =LINESTART 5 SAVE : =ANCHOR ; ANCHOR : =ATBOL END; 

2508 15 4813 378 IF OKTODEL < CURSOR t ANCHOR ) THEN 

2509 15 48:4 387 BEGIN 

2510 15 48:5 387 READJUST ( MIN< CURSOR t ANCHOR )♦ -ABS (CURSOR-ANCHOR )) ; 

2511 15 48:5 402 COPYLINE ! = ( CURSOR=LlNESTART ) AND ATBOT; 

2512 15 48:5 410 IF ANCHOR<CUKSOR THEN 

2513 15 48:6 415 MOVELEFT ( EdUF^CCURSORDtEBUF^C ANCHOR D,8UFC0UNT-CURS0R ) 

2514 15 48:5 424 ELSE 

2515 15 48:6 426 MOVELEFT ( EBUF A C ANCHOR D» EBUF~CCURSOR3«BUFCOUNT-ANCHOR ) 5 

2516 15 48:5 435 BUFCOUNT: =BUFCOUNT-ABS<CURSOR-ANCHOR ) ! 

2517 15 48:5 443 CURSOR:=MIN ( CURSOR t ANCHOR) 5 

2518 15 48:5 452 GETLEADING; CURSOR : =MAX ( STUFFSTARTtCURSOR) 

2519 15 48:4 457 END 

2520 15 48:3 464 ELSE 

2521 15 48:4 466 CURSOR:=SAVE 

2522 15 48:2 466 END 

2523 15 48:i 469 ELSE 

2524 15 48:2 471 BEGIN 

2525 15 48:3 471 COPYLlNE:=FALSE J COPYOK : =TRUE? 

2526 15 48:3 479 COPYSTART: =MlN(CURSORt ANCHOR ) ; 

2527 15 48:3 489 C0PYLENGTH:=A3S(CURS0R-ANCH0R ) 5 

2528 15 48:3 496 CURSOR: =ANCH0R ; 

2529 15 48:2 499 END; 

2530 15 48:i 499 1 : INDELETE : =FALSE ; 

2531 15 48:i 503 OK: =(LINE=STARTLINE ) AND NOT DOFFSCREEN; 

2532 15 48:i 515 UPSCREEN ( OK ,NOT OK, LINE) J 

2533 15 48:1 524 NEXTCO^MAND ; 

2534 15 48:0 526 END; 

2535 15 48:0 540 

2536 15 31:0 BEGIN 

2537 15 31.*1 IF CQM>viaND=DELETEC THEN 

2538 15 31:2 5 DELETING 

2539 15 3i:i 5 ELSE 

2540 15 3l.*2 9 IF COMMAND = AD JUSTC THEN 

2541 15 31:3 14 BEGIN ADJUSTING! NEXTCOMMAND END 

2542 15 3152 18 ELSE MOVING! 

2543 15 ^1:0 22 END! 



2544 15 31: j 54 

2545 lb 31: j ^ 

nil it mi i: (,stf j " ° * 

2550 15 QlZ 1 vAR 

2552 15 flin J JLREADYSAIOGO, THERE. FOUND, LASTPATTERN: BOOLEAN; 

2553 i 5 b lf D ii ^ P "^ integer? 

Hit it 8 o : ° 15 V0DZ: (LITERAL, TOKEN); 

«** ,* :D 1<+ I: INTEGER; 

«?S J« ! :D 15 delimiter: char; 

till H ? :D 16 Justin: boolean; 

till !! o :0 17 possible. pat: ptype; 

llll il f :D ltf5 useold, verify: boolean; 

2560 15 8tD 147 

llll !! <+9:D x procedure nextch; 

2562 15 4910 BEGIN 

2563 15 49:1 o ch:= g etch; 

, 6 J JJ «:i 7 IF CH=CHR(ESC) THEN 

"65 15 49.'2 14 BEBIN 

2567 15 llll \l IF N0T JUSTIN THEN REDISPLAY? 

256ft i? : l z shohcursor; nextcommand; 

lill i\ ,^ :3 28 EXIT(FIND); 

2569 15 49:2 32 E NQ; 

2 2 571° is tl\l 41 IF 3 < C ^HR(E0D) AND JUSTIN THEN 

fs^ H IV 5 n uustin:=false; 

^7u != ^o' 3 45 BLANKCRT(l) 

2574 15 49:2 46 END 

2575 15 49:i 49 ELSE 

2576 15 4912 51 WRITE(CH); 

2577 15 49:0 59 END; 

2578 15 49:0 72 

llll H IV' D * PROCEDURE SKIP; 

2580 15 50:0 BEGIN 

2582 Js till J EN ^ ILE CH IN CCHR(S P ) ' CH R(HT,,CHR(EOL)D DO NEXTCH 

2583 15 5010 30 

2584 15 51 :o 1 PROCEDURE OPTIONS; 2G'5 
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tEGIiM 

REPEAT 

a ch:=jclc(Ch) ; 

6 IF CH='L» THEN 

13 begin mode:=litekal; NEXTCH END 

19 ELSE 

21 IF CH= , V I THEN 

26 3EGIN VERIFY:=TRUEJ NEXTCH END 

33 ELSE 

35 if ch='t' then 

40 begin mode:=token; nextch end; 

46 ch:=uclc(CH) ; 

54 until not uch='v«) or (ch=»t») or (ch=»l»))i 

68 SKIP; 

70 IF (CH=»S') OR (CH='S») THEN USEOLD:=TRUE ! 

84 end; 

98 

1 PROCEDURE PARSESTRING(VAR PATTERN: PTYPE; VAR PLENGTH: INTEGER); 
3 VAR I,j: INTEGER! 

BEGIN 
SKIP; 

2 IF CH IN C•A•.. , Z•,»A• ## •2 , t , 0'..»9»»CHR(BS)3 THEN 
31 BEGIN 

31 ERROR* 'INVALID DELIMITER. ' t NONFATAL ) \ 

56 IF NOT JUSTIN THEN REDISPLAY! 

65 NEXTCOMMAND; 

67 EXIT(FIND); 

7i end; 

71 delimiter:=ch; 
75 i:=o; 

78 REPEAT 

78 NEXTCH? 

80 IF CH=CHR(BS) THEN 

87 BEGIN 

87 IF (PATTERNCIDOCHR(EOL) ) AND (I>0) THEN (* DON'T GO OVERBOARD! *) 

98 BEGIN 

98 WRITE! 1 'iCHR(BS))! 

116 i:=i-i 

117 END 

121 ELSE CONTROL(FS); (* MAKE UP FOR THE <BS> NEXTCH WROTE OUT *) 

127 END 



2626 15 52:2 127 ELSE 

?627 lb 52:3 129 B E 3 1 N 

2623 15 52:4 129 PATTERN! 1 1 : =CH ? 

2629 15 52:4 133 i:=I+l 

2630 15 52:3 134- END; 

2631 15 5211 136 UNTIL (CH=DELIMITER) OR ( I > = MAXSTRING ) ; 
<i632 15 52:i 149 IF I>=MAXCHAR THEN 

2633 15 52:2 156 BEGIN 

2634 15 52:3 156 ERRORfYOUR PATTERN IS TOO LONG» » NONFATAL) ; 

2635 15 32:3 187 IF NOT JUSTIN THLN REDISPLAY; 

2636 15 52:3 196 NEXTCOMMANDJ EXIT(FIND) 

2637 15 52:2 202 END? 

2638 15 52 :i 202 PLENGTH : =1-1 5 

2639 15 52:0 207 END (* PARSESTRING *); 

2640 15 52:0 222 

2641 15 53:D 3 FUNCTION OK(PTR: PTRTYPE): BOOLEAN; 

2642 15 53.*D 4 (* COMPARE PAT AGAINST THE BUFFER *) 

2643 15 53:Q 4 vAR I: INTEGER; 

2644 15 53:0 BEGIN 

2645 15 5311 i:=0; 

Itnt H *l 11 3 WHILE (KPLENGTH) AND < EBUF^CPTR + I 3=PATC I 3) DO i:=I + l; 

2647 15 53:i 29 OK:= I=PLENGTH; 

2648 15 5310 36 END; 

2649 15 53:0 50 

2650 15 54:D 1 PROCEDURE SKIPKIND3 ( VAR CURSOR: PTRTYPE); 

2651 15 54:0 BEGIN 

Itll 11 l*''° ° ( * SKIP 0VER KIND3 CHARACTERS IN THE EBUF. UPDATE THE CURSOR 

2653 15 54!0 TO THE FIRST N0N-KIND3 CHARACTER *) 

nil 11 l? 11 ° WHILE EBUF-CCURSOR3 IN CCHR { SP> ,CHR < HT) ,CHR(DLE) .CHR (EOL) 3 DO 

2655 15 54:2 18 IF EBUF^CCURSOR 3=CHR ( OLE ) THEN CURSOR :=CURS0R+2 

2656 15 54:2 29 ELSE CURSOR : =CURSOR+l ; 

2657 15 54:0 42 ENDS 

2658 15 54:0 56 

2659 15 55:D 1 PROCEDURE SCANBACKWARD; 

2660 15 55:D 1 LABEL i; 

2661 15 55:C 1 VAR 

2662 15 55:0 1 LOC: PTRTYPE; 

2663 15 55!D 2 CHTHERE: BOOLEAN; 

2664 15 55:0 BEGIN 

2665 15 55:i chthere: =TRUE ; oo-, 

2666 15 55:i 3 THERE : =FALSE 5 ^^7 



d u 3 



*l I \l IV 1 7 F ILLCHar( PaT C0:,SIZEOF(PAT),' »); 

All It IV 1 i2 A ' HILE CHTHEF.E AMD NOT THERE DO 

2B70 15 bb:2 4G BEGIN 

2672 Js 5^u ao 1! lF P ™>=PLENGTH THEN (* POSSIBLY THERE •) 

ttli ir ^:t 49 LOC:=SCAN(-PTRi=PATC03,EBUF-CPTRD) 

«ioro lb b5:3 66 ELSE 

HlX 15 b5:t+ 7o loc:=-ptr; 

f'7ft J« «! 3 ?6 IF "-0C = -PTR THEN (* NOT THERE! *) 

2o76 15 55:4 &4 3EGIN 

Itn \l IV? B4 chthere:=false; there:=false 

2678 15 55:4 87 END 

2679 15 5b!3 91 ELSE 

2680 15 5514 93 3E GIN 

Itll \l IVl 93 ptr:=ptr+loc; next:=ptr-i; 

2683 15 55*5 \ll M EBUF^CPTR-l D=CHR ( OLE) THEN BEGIN PT R :=NEXT; GOTO 1 END 

llll II It'll ill EN J F ° K(PTR) THEN there: =true else ptr:=next 

2685 15 55:2 149 END; 

2686 15 55!0 151 END? 

2687 15 55:0 168 

itll J? ! 6:D l procedure scanforward; 

2689 15 56.-D 1 LABEL 1 ; 

2690 15 56:D 1 vAR 

??ol *= 56:D l ma xscan,loc: integer; 

2692 15 56:D 3 CHTHERE: BOOLEAN; 

2693 15 56:0 BEGIN 

2694 15 56:i CHTHERE : = TPUE ; 

2695 15 56:i 3 THERE .* =FALSE ; 

VLZ% 11 ! 6:1 7 FI L-LCHflR(PATC03,SlzEOF(PAT),» •); 

All 11 If 11 17 MOVE I- E FT(TARGETCSTART:,PATCOD,PLENGTH); 

llll 11 ! 6:1 i2 WHILE CHTHERE AND NOT THERE DO 

2699 15 56:2 40 BEGIN 

?7n? 11 it 1 ? if0 1: M AXSCAN: = (BUFCOUNT-PLENGTH)-PTR+l; 

tinl 11 It'.? 53 IF M/ \X SC AN>0 THEN <* STILL STUFF TO SCAN *) 

: it If't 5e L0c:=SCAN(MAXSCAN,=PATC03.E3UF*CPTRD) 

dfi)5 15 56:3 72 ELSE 

2705 15 tV-t It r L °C:= M AXSCAN5 <* DUMMY UP »NOT FOUND' CONDITION *) 

' n . l : , 6,3 79 IF LOC=MAXSCAN THEN 

2707 is ^.-3 n el!e GIN CHTHERE:=false; there:=false END 



27LI8 15 56:4 93 3 % ~ 3 1 .^J 

fill ]t b t: 5 93 '~ptr:=loc + ptr ; next:=ptr+i; 

2711 H till \H l r F ^UF-CPTR-1J=CHR(DLE) THEN BEGIN PTR:=NEXT; GOTO 1 END; 

2712 is bs:\ 1^3 EH \ F 0K<PTR) T,iEN theke:=true else ptr;=next 

2713 15 56.-2 149 END? 

2714 lb 56: 151 rHD . 

2715 15 56:0 168 

V,\% \\ =I :D x p r ocedure goforit; 

2717 15 57:D 1 

VAX \\ tll D l PR0CE DURE NEXTLINE5 

2720 15 SsJo J BEg" VEN NEXTSTART ' CALCULATE THE START AND STOP FOR THE NEXT LINE *> 

llll \l IV' 1 ° lastpattern:=false; 

till IV 1 * start:=nextstart; 

272, is" \VA \\ I^STOP-TL^ 

2725 15 58:i 72 NEX?sT«T ^"StSp+J - THENBEGINST0 P: =M AX < STOP, ) | LASTPATTERN:=TRUE END; 

2726 15 58:0 80 END; 

2727 15 5810 92 

llll \l IV U l PR0CE DURE NEXTTOKEN; 

2730 ll 59lo I BEG?N VEN NEXTSTART « CALCULATE START AND STOP *) 

llll J* -! :1 ° <-astpa T tern:=false; 

ll\l \l ll 11 * start:=nextstart; 

2734 Js sg!! ?° , ( * T SKIP 0VER LEADING KIND3 CHARACTERS *) 

2735 \\ IVA 38 STARt-S^ARt'I' ^ ™ CCHR ( SP) ' C HR ( EOL ) ,CHR ( HT, 3, AND (START<TLENGTH-1 , DO 

Hit 11 IV 1 " 8 stop:=start; 

llll IS IV-i !!* ( * GET ™ E NEXT T °KEN «) 

2739 ^ tl':l 93 WH ^ E p !^^^ ARGE ^ ST ART^=KlNDCTARGETCSTOP + l^) AND <STOP<TLENGTH-l , DO 

2741° is |2i J J?2 STOP :=^<STOP;TLENGTH-l); 

27^2 is' sill 111 ( * JSar'aCTE^} ^ "" ™ E LAST T0KENt SCAN ° FF ™ E TRAILING KI ^ 

f?44 Is I 9 ' 1 U9 NEXTSTARTlsSTOP + l; 

2745 15 IV-l \ll WHlLE ( TARGETCNEXTSTARTD IN CCHR ( EOL) ,CHR (SP) , CHR < HT) 1 ) AND 

2746 15 59m 1*1 TC <NEXTSTART<TLENGTH) DO NEXTSTART: =NEXTSTARm ; 

2747 15 ll\l III END; NEXTSTART=TLE ^TH THEN BEGIN STOP: = MA X ( STOP. ) , LASTPATTERN:=TRUE END; 

2748 15 59.-0 206 2G9 



270 



2749 


15 


57:0 





2750 


15 


57:1 





2751 


15 


57:i 


4 


2752 


15 


5711 


10 


2753 


15 


57:2 


10 


2754 


15 


57:2 


16 


2755 


15 


57:2 


2 


2756 


15 


57:2 


33 


2757 


15 


57:2 


45 


2758 


15 


57:2 


56 


2759 


15 


5723 


61 


2760 


15 


57:4 


61 


2761 


15 


57:4 


67 


2762 


15 


57:4 


71 


2763 


15 


57:5 


81 


2764 


15 


57:6 


81 


2765 


15 


57:6 


94 


2766 


15 


57:6 


104 


2767 


15 


57:6 


109 


2768 


15 


57:6 


121 


2769 


15 


57:6 


131 


2770 


15 


57:6 


146 


2771 


15 


57:7 


157 


2772 


15 


57:6 


157 


2773 


15 


57:7 


163 


2774 


15 


57:5 


177 


2775 


15 


57:3 


179 


2776 


15 


57:3 


179 


2777 


15 


57:3 


179 


2778 


15 


57:2 


179 


2779 


15 


57:5 


205 


2780 


15 


57:6 


205 


2781 


15 


5716 


220 


2782 


15 


57:7 


223 


2783 


15 


57:8 


253 


2784 


15 


57:6 


257 


2785 


15 


57:6 


268 


2786 


15 


57:7 


302 


2787 


15 


57:5 


306 


2788 


15 


57:1 


306 


2789 


15 


t7:o 


316 



^egin(* 3qforit *) 
found:=false; 
next:=ptr; 

REPEAT 

ptr:=,jext; <* set to next place to scan for *) 

nextstart:=o; (* fool nextline into giving us start and stop for line 1 *) 

if mode=literal then nextlime else nexttqken; 

plength:=stop-start+i; 

if directi0n='>' then scanforward else scanbackward ; 

if there then 

3EGIN 

couldbe:=ptr; 

found:=true; 

while (not lastpattern) and found do 

BEGIN 

if m0de=literal then nextline else nexttokenj 

ptr:=ptr+plength; 

skipkind3(ptr) 5 (* go past the junk on the next line *) 

plength:=stop-start+i; (* FOR the new LINE *) 

FILLCHAR(pATC0:i»SIZEOF<PAT),' •); 

moveleft(targetc start dtpatc 3 , plength) ; 
if ptr+plength > bufcount then 
found:=false 

ELSE 

IF NOT OK(PTR) THEN FOUND:=FALSE ; 

end; 
end; 
(* IN TOKEN MODE MAKE SURE THE FIRST AND LAST CHARACTERS 

OF THE TARGET ARE ON 'TOKEN BOUNDARIES' *) 
IF MODE=TOKEN THEN IF KINOCPATC 33=ORD( ' A • ) THEN IF FOUND THEN 
BEGIN 

IF UCOULDBE>2) AND ( EBUF / *CC0ULDBE-23OCHR ( DLE ) ) ) OR 

(c0uldbe<=2) then <* whew ! *) 
if kindcebuf'ccouldbejdrkindcebuf^ccouldbe-ldd then 
found:=false; <* false find... don't count it. *) 

IF (PTR+PLENGTH<=BUFCOUNT-l) and 

(kindcebuf~cptr+plength-i:n=klndcebuf~c ptr+plength id) then 
found:=false; <* another false find *> 

END; 
UNTIL FOUND OR NOT THERE! 
END(* GOFORIT *) ; 



n 



790 15 by,- : 332 



2792 15 bSlo I 3EGIN° JRE PUTPR ° MPT < ^ EFT ' RlGHT : STR ™&: REPEATFACTOR I INTEGER ; LORT : BOOLEAN) ; 

2793 15 60:1 PROMPTLINE : =LEFT 5 PROMPT! 
279t lb b0:i 20 WRITECC); 

2796 15 &5;J 5i jRI IN 7r J - T T 1^ riRlTE(,/,) ELSE ^ITE < REPEATFACTOR ) 5 

2793 7 It loll ill WRI^?Ri^HT r }' IF ^^"^ ™ EN ^ECLUT') ELSE WRITE ( 'T ( OK*) , 

2799 15 S0:0 113 END; 

2800 15 60:0 126 

2801 15 6l:D 1 PROCEDURE REPLACEIT; 

2802 15 Si:D 1 LABEL i; 

2803 15 61:0 BEGIN 

2804 15 Sill o IF VERIFY THEN 

2805 15 61:2 6 BEGIN 

onny H fjl? & CENTERCURSOR ( TRASH, MIDDLE , NOT JUSTIN); 

2808 J! A'-l 11 PUTPROMPTC REPLACE ', '<ESC> ABORTS, "R" REPLACES, " " DOESN"T», 
lint il till II REPEATFACTOR-I+2, FALSE); 

2809 15 61:3 82 SHOWCURSOR; 

2810 15 61:3 85 CH:=GETCHJ 

2811 15 61:3 92 IF CH=CHR(ESC) THEN 

2812 15 61:4 99 3E GIiM 

ll\l \l IV'.l ,?? GETLEADING; CURSOR :=MAX ( CURSOR, STUFFSTART) ; 

:": 15 61,b U1 nextcommand; exit(find) 

2815 15 61:4 H7 END ; 

ll\% H ty** U7 IF «CHO»R») AND (CHO'RM THEN 

2817 15 61:4 126 BEGIN 

2819 ^ lilt i3i REPEATFACTOR:=REPEATFACTOR + l; (* 20-JUN-78 DON'T COUNT FALSE HITS *) 

2820 15 61'4 133 END;™ *' 

2821 15 61:2 133 END; 

"?? J!? f 112 133 ( * REPLACE TARGET WITH SUBSTRING *) 

ilia 11 IV' 1 133 IF SLENGTH>CURS0R-LASTPAT THEN 

282^ 7s A\\ HI IF SLENGTH-(CURSOR-LASTPAT)+BUFCOUNT>BUFSIZE-200 THEN 

toco I'd ol.3 159 BEGIN 

2827 It VM \l* ERRORCBUFFER FULL. ABORTING REPLACE' , NONFATAL) ; 

?fl?q \\ l\'-t l!o GETLEADING; CURSOR : =MAX<CURSOR, STUFFSTART) ; 

Hoi ,= *, J 2 ° 3 NEXTCOMMAND; EXIT(FIND); 

2829 15 =1:3 2m rwn 

2830 15 61!2 214 r LSE 3?1 
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2831 


lb 


61 


3 


2 1 .", 


2332 


15 


61 


i 


22=3 


2633 


15 


61. 


2 


231 


2834 


15 


61* 


3 


240 


2835 


15 


61 


.1 


253 


2836 


15 


61 


;i 


264 


2837 


15 


61 


2 


273 


2838 


15 


61 


:i 


28 4 


2839 


15 


61 


:i 


295 


2840 


15 


61 


:i 


306 


2841 


15 


61 


:i 


310 


2842 


15 


61 


:i 


324 


2843 


15 


8 


:o 
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15 


8 


:i 
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15 


8 


:i 


3 


2846 


15 


8 


:i 


6 


2847 


15 


8 


:i 


10 


2848 


15 


8 


:i 


14 


2849 


15 


8 


;i 


27 


2850 


15 


8 


!2 


32 


2851 


15 


8 


:i 


58 


2852 


15 


8 


:2 


62 


2853 


15 


8 


:i 


102 


2854 


15 


8 


;i 


106 


2855 


15 


8 


:i 


110 


2856 


15 


8 


:i 


112 


2857 


15 


8 


:2 


118 


2858 


15 


8 


;3 


118 


2859 


15 


8 


:3 


126 


2860 


15 


8 


12 


126 


2861 


15 


8 


:i 


130 


2862 


15 


3 


:2 


135 


2863 


15 


8 


:3 


135 


2864 


15 


8 


:3 


139 


2865 


15 


8 


:3 


143 


2866 


15 


8 


:3 


145 


2867 


15 


8 


'4 


151 


2868 


15 


8, 


5 


151 


2869 


15 


8. 


5 


159 


2870 


15 


a: 


4 


159 


2871 


15 


a: 


2 


163 



EL 



MO 
IF 

BU 
CU 
JU 



MOVE 
SE 
IF SLE 

MOVE 
VELEFT 
SLENG 
READJU 
FCOIW 
RSOR 

stin:= 



RIGHT (E.LiUF*C CURSOR J, EBUF~C LASTPAT+SLENGTH : , bUFCOUNT-CURSOR ) 

NGTH<CURSOR-LASTPAT THEN 

LEFT (EBUF*C CURSOR 3iEBUF*CLASTPAT+SLENGTH 3 tBUFCOUNT-CURSOR); 

(SU3STRINGC0 3,EBUF A CLASTPATD.SLENGTH) ; 

THOCURSOR-LASTPAT THEN 
ST(LASTPAT,SLENGTH-(CURSOR-LASTPAT) ) ; 

:=BUFCOUNT+SLENGTH-(CURSOR-LASTPAT) \ 

:=CURS0R +SLElMGTH-(CURSOR-LASTPAT) ; 

FALSE; 



i:end; 



BEGIN 

alreadysaidgo:=false? (* ok to go on without asking! *) 
justin:=true5 
useold:=false; 
verify;=false! 

if pagezero.tokdef then modet=token else mode:=uteral ; 
if comv|and = findc then 
putpro^ptt ' find' i ' <target> =>• »repeatfactor» true ) 

ELSE 

putpromptc replace', • v(fy <targ> <sub> =>• t repeatfactor ttrue ) ! 

needprompt:=true; 

nextch; skip; 

options; 

if not useold then 

BEGIN 

parsestring(target,tlength> ; 
tdefined:=true 
end; 
if command=replacec then 

BEGIN 

nextch; skip; 

useold:=false; 

options; 

if not useold then 

3ESI.M 

parsestring(substring,slength) ; 
sdefined:=true 

END 

end; 
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2573 

287*+ 

2875 

2876 

2377 

2378 

28 79 

2880 

2881 

2832 

2883 

2884 

2885 

2886 

2887 

2888 

2889 

2890 

2891 

2892 

2893 

2891+ 

2895 

2896 

2897 

2898 

2899 

2900 

2901 

2902 

2903 

2904 

2905 

2906 

2907 

2908 

2909 

2910 

2911 

2912 



13 
lb 

lb 

ib 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 



o 

S 

3 

8 

8 

8 

8 

3 

8 

8. 

6; 

8; 

8; 

8; 



:i 
:i 
:i 
:i 
:2 

13 

:3 

13 
13 
14 
5 
5 
5 
6 
7 



8:7 

8:7 
8:6 
8:5 
8:6 
8:7 
8:7 
e:8 
8:9 
8:9 



8; 
8: 

8! 



a:i 
8:i 
8:o 
8:9 
8:o 
8:i 
e:i 
a:i 
a:i 
s:i 
8:2 

615 

e:3 



163 

1 ba 

170 

177 

191 

191 

194 

197 

200 

211 

211 

213 

218 

221 

221 

229 

236 

251 

251 

253 

253 

263 

276 

276 

279 

284 

284 

344 

347 

350 

382 

382 

387 

387 

390 

408 

411 

416 

421 

421 

426 



HOME; 

CLEARLlMtMQ) ; 

IF ( (COiurWJD = FINDC) AND TDEFINED) 

OR ((CO^MAND=REPLACEC) AND SDEFINED AND TDEFINED) THEN 

BEGIN 

i:=i; 

found:=true; 
ptr:=cursor; 

WHILE UK = REPEATFACTOR) QR INFINITY) AND FOUND DO 

3EGIN 

GOFORIT; (* FIND THE TARGET (HANDLES TOKEN AND LITERAL MODE) *) 

I : =i+i ; 

IF FOUND THEN 
BEGIN 

cursor.-=htr+plength; lastpat:=couldbe; <*set up for next time*) 

IF COMMAND=REPLACEC THEN REPLACEIT; 

IF DIRECTIONS' THEN PTR:=COULDBE-l ELSE PTR:=CURSOR; 
END 
ELSE 
BEGIN 

IF <DIRECTI0N='>») AND (RPAGE<FLEN&TH) 
OR (DIRECTI0N=»<») AND (LPAGE>0) THEN 
BEGIN 

IF ALREADYSAIDGO THEN CH:='Y» 
ELSE 
BEGIN 
MSG:=»END OF 3UFFER ENCOUNTERED. GET MORE FROM DISK? <Y/N)»; 

hutmsg; ' 

ALREADYSAIDGO .*=TRUE; 

REPEAT CH:=UCLC(GETCH) UNTIL CH IN [•YS'N']! 

END ; 

IF CHr'Y 1 THEN 
BEGIN 

JUSTlN:rFALSE; (* FORCES REDISPLAY!!! *) 
MSG:=»FINDING»; PUTMSG; 
FOUND :=TRUEi 

I: = I-15 (* REALLY HAVEN'T FOUND ANYTHING *) 
IF DIRECTIONS^' THEN 
BEGIN 

CURSOR:=BUFCOUNT-l; 
PUTPASES(LEFTSTACK); 



273 



274 



am 15 a:i 430 getpages(rightstack) ; 

2914 15 3:2 -+34 END 

2915 15 851 454 ELSE 

2916 15 bJ2 436 BEGIN 

2917 15 3:3 436 CURSOR:=l; 

2918 15 8:3 459 PUTPASES(RIGHTSTACK) ; 

2919 15 8:3 443 GETPAGES(LEFTSTACK) 

2920 15 3:2 444 END; 

2921 15 8:i 4h7 PTR:=CURSOR 

2922 15 8:0 447 END 

2923 15 8:9 450 ELSE 

2924 15 8:0 452 GOTO 15 

2925 15 818 454 END (* ... OR ... *) 

2926 15 8:6 454 END <* IF FOUND THEN ... ELSE ... *> 

2927 15 8:4 454 E N Q; (* WHILE ••• *) 

2928 15 8:3 456 IF NOT FOUND THEN 

2929 15 8:4 460 IF NOT( INFINITY AND <I>2) ) THEN 

2930 15 8:5 470 BEGIN 

2931 15 8:6 470 IF ALREADYSAIDGO THEN 

2932 15 8,*7 473 BEGIN (* CURSOR INVALID *) 

2933 15 8:8 473 CURSOR:=l; 

2934 15 8:8 476 JUSTIN : =FALSE ; 

2935 15 8:7 479 END! 

2936 15 8:6 479 ERROR( ^PATTERN NOT IN THE FILE' * NONFATAL) 

2937 15 8:5 506 END; 

2938 15 8:2 509 END 

2939 15 8:i 509 ELSE 

2940 15 812 511 ERROR('NO OLD PATTERN. ♦ .NONFATAL) ; 

2941 15 S:i 533 i: getleading; 

2942 15 8:i 536 CURSOR: =MAX ( STUFFSTART , CURSOR ) 5 

2943 15 8:1 545 CENTERCURSOR { TRASH, MIDDLE , NOT JUSTIN); 

2944 15 8:i 555 SHOWCURSOR; 

2945 15 8:i 558 NEXTCOMMAND 

2946 15 8:0 558 END; 

2947 15 8:0 584 

2948 15 8:0 534 (*$TC M * A N D INTERFACE*) 

2949 15 8:0 584 

2950 15 2:D 1 PROCEDURE NEXTCOMMANDi 

2951 15 2:0 BEGIN 

2952 15 2:1 Q IF NEEDPROMPT THEN 

2953 15 2:2 5 BEGIN 
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2959 

2960 
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2976 
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15 

15 

15 

15 

15 

15 

15 

15 

15 
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15 
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15 

15 

15 
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15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 

15 
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96 
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2 
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114 


2 


:o 


126 


62 


ID 


1 


62 


:o 





62 


:i 





62 
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62 
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18 


62 


12 


20 


62 


:i 


37 


62 


l 
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62 


:i 


50 
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i 


54 


62! 


l 


58 


62 


l 


62 
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l 


66 


82 


l 


70 


62. 


:i 


74 


62, 


l 


78 


62: 


l 


82 


62: 


l 


86 


62: 


l 


90 


62: 


l 


92 


62: 


l 


96 


62: 


l 
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l 


104 
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l 
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3 
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3 
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3 


127 


62: 


3 
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PR0V:PTLINE: = 
» EDIT: A(DJST C(PY D(LETl FUND KNSRT J(MP R(PLACE Q(UIT X<CHNG Z(AP CL.23»5 
PROMPT ; 

needpro^pt:=false; 
showcursqr 
end; 
ch:=getch; 

command:=maptocommanu(ch> ; 
end(* nextcommand *) ; 

procedure commander; 

3EGIN 

infinity:=false; 
if command=slashc then 
begin repeatfact0r!=15 infinity: =true ; nextcommand end 

ELSE 

if command=digit then repeatfactor:=getnum else repeatfactor:=i; 
case command of 
illegal: begin errwait; sho^cursor; nextcommand end; 
reversecforwardc: fixdirection; 
banishc: banish; 
copyc: copy; 
dumpc: dump! 
findc: find; 
insertc: insertit; 
jumpc: jump; 

listc: nextcommand? (* not yet, depends on terak pan *) 
macrodefc: defmacro; 
nextc: next; 

quitc: ; (* exit handled in outer block *) 
replacec: find; 
setc: setstuff; 
verifyc: verify; 
xecutec: xmacro; 
zapc: zapit; 
equalc: begin 

cursor:=lastpat; 

getleading; 

cursor :=max( cursor, stuffstart) ; 

CEMTERCURSOR(TRASH, MIDDLE, FALSE) ; p^rr 

sho^/cursor; nextcommand ' 
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15 
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i:o 


3001 


15 


1:1 


3002 


15 


1:1 


3003 


15 
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4:1 
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4:1 
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4:1 
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4:0 
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1 
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1 
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1 


8:5 



140 EfJD ; 

144 AD JUSTC t OELETEC, PAKACf UP 1 DOWM» LEFT* RIGHT, ADVANCE t TAB* SPACE: MOVE I T 
144 END (* 3IG LONG CASE STATEMENT *); 
216 END (* COMMANDER *); 
230 

begin (* editcore *) 

nextcomkand; 

2 while commandoquitc do commander 

7 end; 

26 

26 

26 (*$TM ISC. PROCEDURES (INCL. SCREEN CONTROL) *) 

26 

3 FUNCTION MIN(* ( A , B : INTEGER ): INTEGER *)J 
3EGIN 

IF A<B THEN MIN:=A ELSE MIN;=3 

10 end; 
26 

3 FUNCTION MAX (*( A, B: INTEGER )l INTEGER* ) ; 

BEGIN 

IF A>B THEN MAXI=A ELSE MAX:=3 

10 end; 

26 
3 FUNCTION GETCH(*:CHAR*) ! 

3 VAR gch: char; 

BEGIN 

READ(KEYBOARD,GCH) ; 

8 IF EOLN(KEYBOARD) THEN GCH:=CHR < EOL > ; 

21 getch:=gch; 
24 end; 

36 

3 FUNCTION MAPTOCOMMAND(* (CH:CHAR): COMMANDS *); 

BEGIN 

IF (CH=SYSCOM A .CRTCTRL. ESCAPE) AND (CH<>CHR(0)) THEN 
16 BEGIN 

16 ch:=getch; 

22 if chzsyscom~.crtinfo.left then maptocommand:=left 

34 ELSE 

39 IF CH=SYSCOM~.CRTINFO. RIGHT THEN MAPTOCOMMAND : =R IGHT 

51 ELSE 

56 IF CH=SYSCO M ~.CRTINf UP THEN MAPTOCOMMAND:=UP 



3036 1 S:b &b ELSE 



IF CH = SYSCUM~.CRTl\lFO.DOwN THEN MAPTQCOMMAND : =DOWN 



3037 1 3:6 7 

3u38 1 8:6 hi LLSl 

3039 i 6 '7 90 maptocommand:=illegal 

3040 1 8:2 50 END 

3041 1 s:i 93 ELSE 

30i+2 x 3: ^ ^5 «APTdcOMMANU:=TRANSLATECCH3! 

3043 1 8:o 1U4 rND; 

30^4 i a:o 116 

Inll } l'' D 3 FUNCTl O fg UCLC(*(CH:CHAR):CHAR*); <* MAP LOWER CASE TO UPPER CASE *) 

3046 1 9:0 BEGIN 

llll J ||J ° IF CH IN C'A»..»Z»3 THEN UCLC :=CHR ( ORD( CH) -32) ELSE UCLC:=CH 

3049 1 9*0 46 

3050 1 14:D 1 PROCEDURE CONTROL ( *CH ICTYPE* ) ; 

lnl\ I J** 10 2 ( * BASED ° N THE PARAMETER PASSED, USE CRTCTRL TO PUT OUT THE 

3052 1 14:D 2 APPROPRIATE CONTROL CODE FOR THE HOST TERMINAL *) 

3053 1 14:0 o BEGIN 

3054 1 14:i o WITH SYSCOM*. CRTCTRL DO 

3055 1 14:2 7 SEGIM 

3056 1 14:3 7 IF ESCAPEOCHR ( ) THEN WRITE ( ESCAPE ) ; 

3057 1 14:3 26 CASE CH OF 

3058 1 14:3 29 F S.* WRITE(NDFS); 

3059 1 14:3 44 SOHOME: WRITE(HOME); 

3 °°° 1 1<+:3 57 etoeol: write(lraseeol); 

3061 1 14:3 72 ETOEOS: WRITE ( LRASEEOS ) ! 

3062 1 14:3 87 j S : WRITE(RLF) 

3063 1 14:3 100 END 

3064 1 14:2 120 END 

3065 i i4:o 120 end; 

3066 1 14:0 132 

Intl J 1 = : ° 132 ( * L00K AT M£! L00K AT ME! L00K AT MEJ LOOK AT ME! LOOK AT ME! LOOK AT ME! *) 

3068 1 5:D 1 PROCEDURE CLEARSCREEN? 

1™1 J l:^ 1 <* SET T HE SCREEN TO ALL BLANKS AND LEAVE THE CURSOR IN THE UPPER LEFT-HAND 

3 °;° J f- D 1 CORNER (0,0). NOTE THAT THE CONTROL CODE FOR THIS OPERATION IS HARD- 

;:': J ^ x WIRLD < j «e:. it doesn't go through syscom). and thus entails a recomp- 

■30/2 1 b.D 1 ILATION TO CHANGE TERMINALS. P.S, 12 IS A FF. *) 

3073 1 5:0 BEGIN 

307t+ 1 5:i WRITE(CHR(12)) 

3075 1 5:0 8 end; _... 

3076 1 5:0 20 277 



'?7^ 



3077 1 7:D 1 PROCEDURE CLEARLINE ( *Y : INTEGER* ) ; 

5078 i 7:d 2 (* if yojk terminal has an eraseline capability; that is a control code 

3079 1 7:D 2 THAT /JILL CLEAR THE LINE THE CURSOR Is ON, AND LEAVE THE CURSOR AT 

3060 1 7:0 2 THE FIRST COLUMN (OiY) THEN SUBSTITUTE THIS CODE WITH A SINGLE CHARACTER 

3081 1 7:D 2 rtRlTE *) 

3082 1 7:0 BEGIN 
3033 1 7:0 (* 

508(+ 1 7:0 IF YOSCREENHEIGHT THEN UNI TWRITE ( 2 , BLANKAREA . SCREENWIDTH+1 ) 

i03 $ 1 7:0 ELSE Ui\llTWRITE(2,3LANKAREA»SCREENWlDTH) ; 

3086 1 7:0 GOTOXY(OtY); 

3087 1 7:0 *) 

3088 1 7:1 GOTOXY(0»Y); CONTROL ( ETOEOL) ; 
3039 1 7:0 8 end; 

3090 1 7:0 20 

3091 1 15:D 1 PROCEDURE PUTMSG; 

3092 1 1510 BEGIN 

3093 1 15:i CONTROL(GOHOME) ; 

3094 1 15U 3 CLEARLINE(O); 

3095 i 15:1 & savetop:=msg; 

3096 1 1511 14 WRITEMSG); 

3097 1 15:0 24 END; 

3098 1 1510 36 

3099 1 16:0 PROCEDURE HOME; BEGIN CONTROL (GOHOME) END; 

3100 1 16:0 16 

3101 1 3:D 1 PROCEDURE ERASETOEOL ( *X , LINE : INTEGER* ) 5 

3102 1 3:0 BEGIN 

3103 1 3:0 (* 

3104 1 310 IF X = THEN CLEARLINE { LINE ) 

3105 1 3:0 ELSE 

3106 1 3:0 BEGIN 

3107 1 3:0 IF 1_INE=SCREENHEIGHT THEN 

3108 1 310 UNlTwRITE(2, BLANKAREA, SCREENWIOTH-X) 

3109 1 3:C ELSE 

3110 1 3:o UNIT W RITE(2, BLANKAREA, SCREENWIDTH-X+1) 

3iii i 3:o o end; 

3H2 i 3:o o gotoxyu.line) ; 

3113 i 3:0 *) 

3ii<+ i 3:i o contrOlcetoeol) ; 

3115 1 3:0 3 e^o; 

3116 1 3:0 16 

3117 1 6:0 1 PROCEDURE ER ASEOS ( *X , LINE* ) ; 



3118 i &:3 -i VAR I; ImtEGER! 

3 H9 1 &:o (J ~,EGIN 

3120 1 6:0 c (* 

3121 1 &:^ ERASETj£OL(X,LINE) ; 

\\i\ \ lYi ' J F0R I:=LINE + 1 TO SCRtENHEIGHT OG BEGIN WRITELN; CLEARLINE(I) END! 

312i+ 1 oil CONTROL(ETOEOS); 

3125 1 6:o 3 end; 

3126 1 &:o 16 

3127 1 10:0 1 PROCEDURE PROMPT; 

3128 1 10:C 3EGIM 

3129 i 10:1 o promptlineci3:=direction; 

3130 i 10:1 & savetop:=promptline; 
3i3i i 10:1 ii+ contrOhgohome) ; 

3132 i 10:1 17 CLEARLinE(O); 

3133 1 lo:i 20 WRITE(PROMPTLINE) 

3134 i io:o 30 end; 

3135 1 10:0 42 

3136 1 17ID 1 procedure errwait; 

3137 1 17:0 BEGIN 

3138 1 1711 WRITE(CHR(BELL))5 

3139 1 17!1 8 PROMPT; 

3140 i 17:0 io end; 

3141 1 1710 22 

3142 i is:d 1 PROCEDURE BLANKCRT(*y: INTEGER*); 

3143 1 18:o BEGIN 

3144 i ia;o o ( * 

3145 1 18:0 IF Y=l THEN 

3146 1 1810 BEGIN 

3147 i ie:o o cleaRscreen; 

3148 1 18:0 WRITELN(SAVETOP) 

3149 1 ie:o END 

3150 1 18:0 ELSE 

3151 1 18:0 BEGIN 

3152 i ib:o o gotoxy(o,Y); 

3153 1 18:0 ERASEOS(0,Y)? 

3154 i i8:o o end; 

3155 1 1810 *) 

3156 1 16:1 o GOTOXY(O.Y); 

3157 1 18:i 5 CONTROL(ETOEOS) 

3158 i is:o 6 end; 279 
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PROCEDURE ERR0R(*S: STRING ? HOwBAD : ERRORTYPE*)! 

UNlTCLuAR(l) 5 (* THROW AWAY ALL CHARACTERS QUEUED UP *) 
IF H0W-3AQ = FATAL THEN 

BLANKCRT(l) 
ELSE 

3EGIN HOME; CLEARLINE(O) END; 
WRITE( 'ERROR: ♦.S); 
IF HOW3AD=FATAL THEN 

EXIT(EDITOR) 
ELSE 

BEGIN 

write(» please press <spacebar> to continue.') j 
repeat until getch=» '; needprompt :=true 
end; 
end; 

(*$tu tility procedure s*) 

function leadblanksu (ptr: ptrtype; var bytes: integer): integer *)} 

(* ON ENTRY- 

PTR POINTS TO THE BEGINNING OF A LINE 
ON EXIT- 
FUNCTION RETURNS THE NUMBER OF LEADING BLANKS ON THAT LINE. 
3YTES HAS THE OFFSET INTO THE LINE OF THE FIRST NON-BLANK CHARACTER *) 
VAR 

OLDPTR: PTRTYPE; 
INDENT: integer; 
3EGIN 

oldptR:=ptr; indent:=o; 

WHILE ORD(EBUF A CPTR3> IN CHT » SP t DLE3 DO 
BEGIN 

IF EBUF A CPTR3=CHR(DLE) THEN 

3EGIN PTR:=PTR+l; INDENT:=INDENT+0R0(EBUF*CPTR3)-32 END 
ELSE 

IF 0RD(EBUF^CPTR3)=SP THEN INDENT:=INDENT+1 
ELSE 

(*ht*) indent:=( (indent div 8)+l)*8; (* kludge for columnar tab! *) 
ptr:=ptr+i 
end; 



3200 1 iq :1 75 



BYTES:=pTR-OLOPTR 



„ r U J J ^- X ^0 LEAD3LArjKS; = INDENT; 

??" ] " :n « END(«LEA03LANKS*); 

i<! « 1 19.* 93 

^205 i JJl~ X PR0 CEDURE REDISPLAY; 

1 | 111 | ji£lfB£sss"°- sJurnasr-A-ssaa.-. 

J2J! J nIS * lin edist,eoldist,linl: INTEGER; 

3211 1 11 PTR: P TRTYPE| 

3212 1 "IS 5 8E Jj N PACKED ARRAY C 0.. M AXSW3 OF CHAR; 



3213 1 11:1 



BLANKCRT(l) 



321£f 1 u:i 3 LINE-=l' 

llll } "J J & ptr:=lineiptr; 

3217 1 m U REp EAT 

3218 1 11 ip " ! LANKS:=MI N(IEADBLANKS(PTR,3YTES),SCREENWIDTH); 

3220 1 ifi? 30 ptr:= p tr + bytes; 

3221 1 u.'f ?! "LDlSTlsSCAiyKMAXCHAR.sCHRCEOD.EBUF-CPTRD)! 

3222 1 11J2 " ^F^JlX**'^ 



3223 ^ " ;0VELEFT( E BUF^PTR3,TC03,LlNE5Jin7 

322, 1 if., I? IF E 3UF-CPTR + LI|\JED1STK>C|- 

3225 1 i\:l 11 TC« A X(0.LINEDIST-X)3:=« 



322, l 11: : 3 2 It lF T ^575:;;;^«?i?T?<>?«?!«L, THEN <* LINE TRUNCATION *) 

3226 i ii: : 2 2 lfl " S T R "EJiIi"!!F2"I! 



3227 1 iiM J?f iim pt R : =p™+eoldist + i; line:=line + i 

3228 1 IIlJ HI END; (LINE>SCRE ^HEIGHT) OR (PTR>=BUFC0UNT) 

3229 1 11:0 138 

303? J *|° * P R0CE DURE CENTERCURSOR 



3232 J IS!d J (T^GU^ OUt'TthV c!SSr P ;, I !I5, GER, . NE| ' SCREENI BOOLEAN*), 

im l 2 2 o°!S : VAR T ° -e E ac T ?ua P l° S ^Je ON th T e HE cSr U S R o S r° R wa A s T Sed'^T' UNE IS THEN U — 



Ilia I 2 SIS 4 MARK: integer; 
3238 1 2o:d 5 ptr: ptrtype; 



3239 1 20:0 



BEGIN 



32^0 1 20:i IF 



E3liF-CCURSOR3=CHRCEO U THEN PTR:=CURSOR ELSE PTR :=CURSOR + l | 281 



23?. 



32<U I ,20 U 17 LIiME:=i)! 

3242 1 2011 20 REPEAT 

3243 1 20:2 20 PTR:=PTR-1; 

3244 1 20:2 25 PTR:=SCAM(-MAXCHARi=CHR(E0L).E8UF"CPTRD)+PTR; 

3245 1 20:2 40 LINE:=LINE+1! 

3246 1 20:2 46 IF LIfjE = LINESUP THEN MARK;=PTR? 

3247 1 20:i 55 UNTIL < LINE>SCREENHEIGHT ) OR < ( LINE1PTR=PTR+1 ) AND NOT NEWSCREEN) OR (PTR<1); 

3248 1 20U 76 IF LINE>SCREENHEIGHT THEN <* OFF THE SCREEN *) 

3249 1 20:2 62 BEGIN LIfJElPTR : =MARK + 1 ; REDISPLAY; LINEI=LINESUP END 

3250 1 20:i 93 ELSE 

3251 1 20:2 95 IF LINE1PTR=PTR+1 THEN 

3252 1 20:3 104 BE3IN 

3253 1 20:4 104 IF NEWSCREEN THEN REDISPLAY 

3254 1 20:3 107 END 

3255 1 20:2 109 ELSE 

3256 1 20:3 111 BESIN 

3257 1 20!4 111 LINE1PTR:=1; REDISPLAY 

3258 1 20:3 115 END; 

3259 1 20:0 117 END; 

3260 1 20:0 132 

3261 1 21!D 1 PROCEDURE FINDXY(*VAR INDENTiLINE; INTEGER*); 

3262 1 2l:D 3 VAR 

3263 1 2i:D 3 ItLEAD; INTEGER; 

3264 1 2i:D 5 PTR.EOLPTR: PTRTYPE5 

3265 1 21:0 BEGIN 

3266 1 21:0 (* PLACE CRT CURSOR ON THE SCREEN AT THE POSITION CORRESPONDING 

3267 1 21:0 TO THE LOGICAL CURSOR. *) 
3263 1 2l:i LINE:=l; 

3269 1 21:1 3 ptr:=lineiptr; 

3270 1 2l:i 8 EOLPTR:=SCAN<MAXCHAR»=CHR(EOL)»EBUF*CPTR3)+PTR? 

3271 1 2i:i 22 WHILE EOLPTR<CURSOR UO 

3272 1 21:2 27 BEGIN 

3273 1 21:3 27 LlNE:=LINE+l; PTR:=EOLPTR+l; (* SET UP FOR THE NEXT LINE *) 

3274 1 21:3 38 EOLPTR:=SCAN(MAXCHARi=CHR(EOL) »EBUF A CPTR3) +PTR 

3275 1 2i:2 48 END? 

3276 1 21:2 54 (* now find the indentation on that line of the cursor *) 

3277 1 21:1 54 lead:=leadslanks(ptr»I) ; 

3273 1 2l:i 63 indent:=min(screenwluth,(lead-i)+{cursor-ptr) ) ; 

til 3 1 21!1 77 <* (EXTRA SPACES) + (OFFSET INTO LINE) *) 

3280 1 2H0 77 END5(* FlNDXY *) 

3281 1 n:o 92 
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1 PROCEDURE: SHOWCURSOR; 
I v/AR 

1 X,Y: INTEGERS 

bEGlN 

FlNDXY(XiY) ; 

6 GOTOXY(XtY) 

11 ENO(* SHOWCURSOR *) 5 
24 

3 FUNCTION GETNUMC*: INTEGER*) ; 

3 VAR 

3 n: integer; 

4 OVERFLOW: BOOLEAN; 
BEGIN 

im:=o; 

3 overflow:=false; 

s if not (ch in c , 0*..»9»3) then n:=l 

23 ELSE 

28 REPEAT 

28 IF N > 1000 THEN OVERFLOW :=TRUE 

35 ELSE 

*+0 3EGIN 

**o n:=n*io+ord(ch)-ord( »o» ) ; 
■+9 ch:=getch 

W END 

55 UNTIL (NOT (CH IN C'0»..»9 , 3)) OR OVERFLOW? 
73 IF OVERFLOW THEN 
76 BEGIN 

76 error(»repeatfactor > 10 . 000 ', nonfatal) j 
103 getnum:=o; 

106 END 
106 ELSE 

108 getnum:=n; 

Jil command:=haptocomhand(ch); (* TAKES ch and maps it to A COMMAND *) 

118 E N D » 
132 

1 PROCEDURE GETLEADING; 
BEGIN 

(* sets: 

LINESTART A POINTER TO THE BEGINNING OF THE LINE 

STUFFSTART A POINTER TO THE BEGINNING OF THE TEXT ON THE LINE 

U 3YTES THE NUMBER OF BYTES BETWEEN LINESTART AND 
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stuffstart 

blanks the indentation of the line *) 

lincstart:=cursor; 

if eauf*clinestart3=chr<eol) then linestart : =linestart-1 \ <* for scan! *) 

LlNESTART:=SCAr\l(-MAXCHAR,=CHR<EOL),EBUF~CLINESTART:)+LINESTART + l; 
BLANKS :=LEADBLANKS( LINESTART. 3YTES) ; 
STUFFSTART :=L I NEST ART+BYTES 
END (* GETLEADING *) ; 

FUNCTION OKTODEL (* (CURSOR* ANCHOR: PTRTYPE ): BOOLEAN *) ! 
BEGIN 

IF ABS(CURSOR-ANCHOR)XBUFSIZE-BUFCOUNT)+10 THEN 
BEGIN 

msg: = 
•there is no room to copy the deletion. do you wish to delete anyway? (y/npi 

PUTMSG; 

if uclc(getch)=«y' then oktodel:=true else oktodel:=false; 

END 
ELSE 
BEGIN 

(* copyline is set by the caller *) 

copyok:=true; copylength:=abs(CURsor-anchorj s 

copystart:=bufsize-copylength+i; 

moveleft(ebuf*cm in { cursor. anchor) 1, ebuf^ccopystart 1 tcopylength) j 

oktodel:=true 
end; 
end; 

procedure lineoutuvar ptr:ptrtype; bytes. blanks, line:integer*> ; 
(* write a line out *) 

VAR 

linedist.eoldist: integer; 

t: packed array co..maxsw:i of char; 

begin 
gotoxY(slanks.line) ; 

PTRrrPTR+BYTES; 

eoldist:=scan(maxchar.=chr(eod .ebuf~cptR3> ; 

LINEDIst:=MAX(0.MIN(EOLDIST,SCREENWIDTH-BLANKS+D) ; 

w!oveleft(ebuf a [:ptr:,uod.linedisT) ; 

if e3uf^[:ptr + linedistj<>chr' *l) then (* line truncation *) 



^ 1 26:2 b j 3EGI; , 

U*Z J ? 6:3 60 li.medist:=max(linedist.i>; 

"ofa 1 Z6i- 6 33 TCLINEDIST-I3: = »f»; 

3367 1 26:2 75 END! 

3368 1 26:i 75 KJRI TE < T : LIWEDI ST ) ; 

3369 1 26:i 85 PTR : =PTR+E0L0IST+1 

3370 i 2&:o 90 end; 

3371 1 26:0 106 

3373 \ IV.l } PR0CE DURE UPSCREEN(*FIRSTLINE,WH0LESCREEN: BOOLEAN; LINE: INTEGER*); 

IVll 1 2 ? ( * ?J^ C IN ^ RT AND DELETE CALl - THIS PROCEDURE TO UPDATE POSSIBLY PARTIALLY, 

3375 1 ll'.Z a Ir E , CR N ' "RSTLINE MEANS ONLY THE LINE THAT THE CURSOR IS ON NEED 

3376 1 tl'A 1 II UPDATED. WHOLESCREEN MEANS THAT EVERYTHING MUST BE UPDATED. IF 

3377 6 i 2 % 7 : D j : irziz i^d&ps then only the part of the scr ™ ™* ?;s ^ R 

3378 1 27:D 4 VAR 

3379 1 27:D 4 PTR: PTRTYPE; 

3380 1 27JD 5 

3381 l 27:0 BEGIN (* UPSCREEN *, 

3382 l 27H IF FIRSTLINE THEN 

3383 1 27:2 3 BEGIN 

lilt J 27:3 3 GETLEADING! 

3386 \ ll\l ,? GOTOXY(0,LINE); ERASETOEOL ( • LINE) 5 <* CLEAN THE LINE *, 

33^7 1 27:1 It ^LlNEOUTtLINESTART, BYTES, BLANKS, LINE, (« JUST THIS LINE i, 

3388 1 27:i 21 ELSE 

3389 1 27:2 23 IF WHOLESCREEN THEN 

?V» 1 llll 2G CENTERCURSOR(TRASH, MIDDLE, TRUE) 

3392 1 27.*3 37 ^tl^H ° NLY ^^ ^ PART ° F ™ E SCREEN AFTER THE CURS °* *> 

3394 J IIH fl GOTOXY(0,LINE)J ERASEOS ( ,LINE) 5 

Hit i ?J' 4 ^ setleading; 

"!? J 27:4 hb ptr:=linestart; 

3396 1 27:4 51 REPEAT 

3398 1 tV-l ?J S LANKS:=MIN(LEADBLANKS(PTR,BYTES,.SCREENWIDTH)5 

3399 I 27J5 °\ |-I^OUT (PTR , BYTES, BLANKS, LINE ) ; <* WRITES OUT THE LINE AT PTR *> 

34oJ \ *¥A II , mU ' L ! LINE >SCREENHEIGHT) OR (PTR>=BUFCOUNT) 

^ wx x "'j 06 END; 

3402 1 27:0 86 END; 

3403 1 27:0 100 

3404 1 28:D 1 PROCEDURE READJUST * C URSOR : PTRTYPE i DELTA: INTEGER*); 285 
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ALL AFFECTED 
DELTA *) 



<* IF DELTA<0 THEN MOVt 
MARKERS >= CURSOR BY 
VAR 

i: INTEGER; 
BEGIN 

WITH PAGEZEPO DO 

FOR i:=0 TO COUNT-1 DO 
IF PAGENCI3=-1 THEN 

IF POFFSETCn> = CURSOR THEN 
BEGIN 

POFFSETClD:=MAX{POFFSETCID+DELTA,CURSOR); 

end; 
if (copystart>=cursor) and ( cqpystartcbufcount ) then 

COPYSTART:=MAX(COPYSTART+DELTA» CURSOR) ; 



BARKERS TO CURSOR. ALSO ADJUST ALL 



end; 

procedure thefixer(*paraptr:ptrtype;rfac: integer; whole: boolean*) ; 

(* paraptr points somewhere in a paragraph. if whole is true then the 
entire paragraph is filled, otherwise only that directly after the cursor 
is filled. rfac, when implemented will tell how many paragraphs to be 

FILLED. NOTE: A PARAGRAPH IS DEFINED AS LINES OF TEXT DELIMITED BY A LINE 
WITH NO TEXT ON IT WHATSOEVER, OR A LINE OF A TEXT WHOSE FIRST CHARACTER IS 
RUNOFFCH *) 

VAR 

savefptr»wptr: integer; 
wlength.x: integer; 
done: boolean; 

BEGIN 

WITH PAGEZERO DO 
BEGIN 

save:=cursor; 

cursor:=paraptr; 

getleading; 

if ebuf^cstuffstart} in cchr ( eol ), runoffch] then exit ( thefixer ) » 

if whole then (* scan backwards for the beginning of the paragraph *) 

3EGIN 
REPEAT 

cursor:=linestart-i; 
getleading 
until (linestart<=1* "r ( ebuf a cstuffstart3 in crunoffch , chr(ec 1); 
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IN C^UNOFFCH,CHR(EOL)D THEN 



THEN X:=PARAMARGIN ELSE X:=LMARGIN 



*) 



if ebuf^cstuffstartd 
ptr:=cursor+i 

ELSE 

ptr:=i; 
x:=paramargin; 

END 
ELSE 
BEGIN 

ptr:=linestart; 

if blanks=paramargin 
end; 

cursor:=bufsize-<bufcount-ptr)+i; (* split the buffer 
moveright(Ebuf-cptr:,ebuf^c cursor 3, bufcount-ptr); 

(* NOW DRIBBLE BACK THE (REST OF THE) PARAGRAPH *) 

EBUF^CPTR^sCHRtDLE); 

EBUF' s CPTR + lD:=CHR(X + 32) ; 

ptr:=ptr+2j 

EBUF'CCURSOR-n^CHRtEOL); (* SENTINEL FOR GETLEADING *) 

done:=false; 
repeat 

WHILE EBUF^CcURSORD IN CCHR (HT) »CHR(SP) .CHR (DLE) 1 DO 

^Jp.^n^no^ 50 ^^^ 101 -^ THEN CURS0R:=CURS0R+2 ELSE CURSOR ^CURSOR+l J 
<* SKIP OVER A TOKEN *) 

WHILE NOT (EBUF-CCURSOR3 IN CCHR(EOL),* »,»-»:> DO CURSOR:=CURSOR+l ; 
(* SPECIAL CASES FOR ».<SPXSP>'» AND »-<SP>» *) "' 

IF E3UF-CCURsORD=»-» THEN IF EBUF~CCURSOR+l 3=» • THEN CURSOR:=CURSOR+l 5 
IF (EBUF^CCURSOR-13 IN r • .»,•?•, t| '♦»«♦ 1) THEN IF uunauK-n, 

(EBUF-CCURSOR 3 =» ») AND ( EBUF-CCURSOR+13=» •) THEN CURSOR:=CURSOR+l ; 

i (* INCLUDING THE DELIMITER *) 
OR (RMARGlN-LMARGlN+KsWLENGTH) THEN 



wlength:=cursor-wptr+i 
if (x+wlength>rmargin) 

BEGIN 

IF EBUF-CPTR-1D=' • THEN PTR:=PTR-15 

ebuf"Cptrd:=chR(eod ; ebuf*cptr+id:=chr<dlE) ; 

ebuf^cptr+23: = chr(lmargin+32) ; 

ptr:=ptr+3; 

x:=lmargin 
eno; 
cu«sor:=cursor+i; 

MOVELEFTCEBUF^CWPTRD.EBUF^CPTRJ.WLENGTH); 
IF E3UF^CCURS0R-1]=CHR(E0L) THEN 
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dEGIN 

IF E3UF w i:CJRSOR3 = CHR(0) THEN D0NE:=TRUE 
_LSE 
BEGIN 

GETLEAUIN5J 

D0NE: = (EB'JF A CSTJFFSTART3=CHR(E0L) ) 

OR (EBUF^CSTUFFSTARTDsRUNOFFCH) ; 
(* THE LAST TRANSFER WILL MOVE 

OVER THE <EOL> FOR THE PARAGRAPH *) 
IF NOT DONE THEN 
BEGIN 

EBUF^CPTR+WLENGTH-ia:=» • ; 

(* IF <EOL> <SP>, MAP TO ONE SPACE ONLY *) 
IF EBUF~[:cURS0R-2:= , ♦ THEN PTR:=PTR-1? 
END 
END 

end; 

x:=x+wlength; 

ptr:=ptr+wlength; 
until DONE? 

readjust(paraptr» (bufsize-cursor+ptr+d-bufcount) ; 
bufcount:=bufsize-cursor+ptr+i; 
moveleft(ebuf^c cursor diebuf^cptr 3. bufsize-curs0r+1) « 
ebuf"cbufcount3:=chr<0) ; 
cursor:=min(Bufcount-i»save) ; 
getleading; 
cursor :=max( cursor, stuffstart) 

end; 
end; 

procedure getname(*msg:string; var m:name*); 

VAR 

i: integer; 
s: string; 

BEGIN 

neeoprompt:=true; home; clearline(O) ; writecmsg*' what marker? m 
readlN(s) ; 

FOR i:=l TO LENGTH(S) DO SCia:=UCLC(SClD) ; 

moveleft(sci:»mco:,min(8»length(S) ) ) ; 
fillchar(mclength(s)3»max(0,8-length(s) ),♦ ») 
end; 



3528 1 30 :0 150 

3529 1 30:0 150 

J"0 1 3S'.Q i ^RQCEDjRE DISKERR; 

35ol 1 36:0 u : ;EGIw 

3533 J" «ij .? k ERR0R(, 3AD DISK TRANSFER. », NONFATAL) I 
ooii 1 36:0 2*+ end; 

3534 1 3&:o 36 

3536 I ll\u 4 VAR CTI0N WRITEIT( * WHICH:LEFTRIG ^) BOOLEAN*), 

llll t ^ :D * FULL: boolean; 

3538 1 34J0 o BEGIN 

till J *u'J ° FUL L:=(LPAGE+1>=RPAGE); 

^u? J I?' 1 1X IF N0T FULL THEN 

3541 1 34:2 15 BEGIN 

3543 t 11:1 J? IF WHICH=LEFTSTACK THEN 

3343 1 34:4 20 BEGIN 

Hit J 24:5 2 o lpage:=lpage + i; 

3546 1 34*4 53 r J F BL0CKWRlTL( DEFILE, PAGEBUFFER, 2,LPAGE + LPAGEK>2 THEN DISKERR 

3547 1 34:3 55 ELSE 

3548 1 34:4 57 3 EGIN 

3550 I 11H 57 RPage:=rpage-i; 

3551 1 34.*' 90 FW n F BL ° CKWRlTt <THEFI L E,PAGEBUFFER .2 .RPAGE+RPAGEK>2 THEN DISKERR 

3552 1 34:2 92 END; 

llll J V' 1 92 wri teit:=not full 

3554 1 34:0 92 END; 

3555 1 34:o 108 

3557 I 33'° I vAR CTl ° N READIT ( * WHI CH:LEFTRlGHT> : BOOLEAN*); 

llll I IV D " tapcity: boolean; 

3559 1 33:0 BEGIN 

356? I III J ° TAPClTy : = ((WHICH = LEFTSTACK) AND (LPAGE<=0)) OR 

3562 1 3 3 3 3 U J IF N0T taPC^'hEN 16 " 15 ™ ' * N ° (RPAGE >= F ^GTH) , ; 

3563 1 33:2 27 BEGIN 

356^ 1 lllu \l IF WHICH=LEFTSTACK THEN 

03&b 1 33:4 32 3EGIN 

3W 1 33l5 " J F BLOCKREAD ( THEFILE , PAGEBUFFER , 2 ,LPAGE + LPAGE , <>2 THEN DISKERR; 

3568 1 33J4 62 £| ^ -«-PAGE-l 
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29fi 



else: 

3EGIN 

if 8l0c«read(thefile»pagebuffer,2,rpage+rpagek>2 then diskerr; 
rpage:=rpage+i 

END 

end; 

READlT:=fMOT TAPCITY5 

end; 

procedure getpages(*which:leftright*) ; 

<*WHICH IS WHICH STACK YOU WANT TO READ FROM. STOPPING CONDITION: APPROXIMATELY 

2000 CHARACTERS OF SLOP LEFT IN THE BUFFER OR NO MORE STUFF TO READ *) 
VAR 

it start, stuffcountttherest.notnulls: integer; 
notdqne: boolean; 

BEGIN 

if copystart>bufcount then copyok:=false; (* TRASH copy BUFFER *) 

notqone:=true; 

IF WHICH=RIGHTSTACK THEN 

BEGIN 

start:=bufcount? 

while (start<8ufsize-3000) and notdone do 

BEGIN 

notdone:=readit(Which) ; 
if notdone then 

BEGIN 

NOTNULLS:=SCAN( -1024 »<>CHR(0)fPAGEBUFFERC 10233) +1024 » 
MOVELEFT(PAGEBUFFER»EBUF*CSTART3*NOTNULLS); 
WITH PAGEZERO DO (* SWAP IN MARKERS *) 
FOR i:=0 TO COUNT-1 DO 

IF PAGENCI3=RPAGE-1 THEN 
BEGIN 

pagenci::=-i; 

poffseti:i3:=poffsetcid+start; 
ENO; 
start :=start+notnulls; 

WRITE( •.» ) 

END 

END; 

bJfcount:=start; 
ebjf"C3Ufcount::=chr(0); 



361u 1 51 H i3 7 



LfJU 



5611 1 3i:i 157 ELSE 

3612 1 3112 169 3EGIN (* LEFTSTACK *) 



361J 1 31:3 159 



THEREST:=dUFSl2E-BUFC0UNT+l 



3614 1 31:3 166 START : =THEREST-1 5 

?M- t ^i i:i 171 READJUSTC1, START); 

:,: , ^. ,3 ld2 WHILE <START>=3000) and notdone do 

OolS 1 3i -if 191 BEGIN 

«20 1 ^.^ Jf 1 NOTDONE:=READIT(WHlCH); 

<!*? I ! 5 198 IF NOTDONE THEN 

0b21 1 31:6 201 3EGIN 

3623 1 3i: : 7 222 Sn^l SJ!^?!^ ,<>CHR ( ° > ' P AGEBUFFERC10233) + 102m 

3626 1 IV.l tun WI ™ P ^ZZRO DO (* SWAP IN MARKERS *) 

3627 1 3i'q lit F0R I!S ° T0 COUNT-1 DO 

0°*' 1 01.9 255 TC DAP.r.,r t i_i n«<-r- . . , 



3628 1 alio 2 2 70 lF B ^ NC J J=LPAGE + 1 THEN 

3629 1 31:1 270 Pa2 E NCI3--1 

3630 i 31:1 279 p^.E:: 1 ::: 1 

END; 



3629 1 31 :l 270 8 P^ L 

363? 1 3X.-0 297 - P?FFSETCI3:=POFFSETC n+START + 1 ; 



Hit i IV.l 2°" HRITEC.Ml 

3633 1 31:6 312 END 

3634 1 31:4 312 END; 

lt¥ J H : i 3l " stuffcount:=bufsize-start; 

tlti i till l ls cursor:=cursor + stuffcount-bufcount; 

TAI } I 1 ' 325 READJUSTd, -START); 

,,,* J » 1:3 331 bufcount:=stuffcount; 

3640 i 31.-2 343 EN ^ LEFT < "UF^C STAR T + 1 3 , EBUF^C 1 3. STUFFCOUNT ) ; 

3641 1 3i:i 343 EBUF^C 3UFCOUNT3 : =CHR < ) ; 
3o42 i 3i :o 347 END . 

3643 1 31:0 372 

364S } \l\^ l pR0CE °ure putpages(* wH ich:leftright*); 

3646 1 32j'o 2 ^ RIGHT^ "JSk""?" '^ ^ ° UT T ° ™ E LEFT STACK 0T H««SE SWAP OUT TO THE 

3647 1 32:D 2 VAR 

3649 \ IV-? o ^STOPJIARK, SAVE, ONEPAGE.PTR. LAST: INTEGER? 
„ f ""L- 8 ok: 300LEAN; 

3650 1 32:0 9 o'qt 



or 
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37:D 3 FUNCTION MOVEITO UT ( STAKT , STOP : I MTEGER > : BOOLEAN! 

37:D 5 VAR I: INTEGER; 

37:0 BEGIN 

37:i IF ST0P>=START THEN 

37:2 5 BEGIN 

37!3 5 M0VELEFT(E3UF*[SrART3»PAGEBUFFERiST0P-START+l>l 

37:? 18 FlLLCHAR(PAGEBUFFERCSTOP-START+i:M023-<STOP-START)»CHR<Q) ); 

37:o 36 M0\/EIT0UT:=WRITEIT(WHICH) ; 

37:3 45 WITH PAGEZERO DO (* SWAP OUT MARKERS *) 

37:4 45 FOR i:=0 TO cOUNT-1 DO 

3 7:5 fe0 IF (PAGENCI3=-D AND (POFFSETC I D>=START ) AND ( POFFSETC I3<=STOP) THEN 

37:6 92 BEGIN 

37:7 92 IF WHICH=LEFTSTACK THEN PAGENC I D:=LPAGE 

37:7 105 ELSE PAGENC I 3:=RPAGE ; 

37:7 121 poffsetcid:=poffsetci3-start; 

37:6 137 end; 

37:3 144 WRITEC.M 

37:2 152 END 

37U 152 ELSE 

37:2 154 moveitout:=false 

37:0 154 end; 

37:0 174 

32:0 BEGIN (* PUTPAGES *) 

32:i IF WHICH=LEFTSTACK THEN 

32:2 5 BEGIN 

32:3 5 LAST:=MAX(CURSOR-200.1) ; (* SLOP IS 200 *) 

32:3 17 ptr:=i; 

32:3 20 REPEAT 

32:4 20 onEPAGE:=MIN(PTR+1022,LAST) ; 

32:4 32 STOPMARK:=SCAN(-MAXCHAR.=CHR<EOL) ,EBUF"CONEPAGE3)+ONEPAGE; 

32:4 47 IF PTR < STQpMARK THEN 

32:5 52 BEGIN 

32:6 52 ok:=moveltout(ptr»stopmark) ; 

32:6 60 if ok then 

32:7 63 ptr:=stopmark+i 

32 : 6 64 ELSE 

32*7 70 ERR0R(»RAN OUT OF DISK ROOM* . NONFATAL ) ? 

3215 96 END 

32:4 96 ELSE 

32:5 98 ok:=false; 

32:3 101 UNTIL NOT OK OR (ONEPAG£ AST); 



3692 

36;>3 

3694 

369o 

3696 

3697 

3698 

3699 

3700 

3701 

3702 

3703 

3704 

370b 

3706 

37U7 

3708 

3709 

3710 

3711 

3712 

3713 

3714 

3715 

3716 

3717 

3718 

3719 

3720 

3721 

3722 

3723 

3724 

3725 

3726 

3727 

3728 

3729 

3730 

3731 

3732 



1 

1 

i 

1 

1 

1 

1 

1 

1 

1 

i 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 
1 
i 
1 



32, 
32; 
32: 
32: 
32: 



3213 
32:3 
32:3 
32:3 
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3213 
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32:6 
32:3 
32:2 
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1U9 

109 

116 

122 

143 

150 

159 

163 

163 

163 

163 

163 
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229 
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251 

253 

256 
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273 
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311 

317 

343 

34 3 

345 



(* PTR NOW POINTS TO THE: FIRST VALID CHARACTER IN THE BUFFER *) 

IF COPYSTARKPTR THEN COPYOK : =FALSE 

ELSE 

IF COPYOK AND < C0PYSTART<3UFC0UNT ) THEN COPYSTART: =COPYSTART-PTR+l 5 

bufcount:=sufcount-ptr+i; 

m0\/eleft(ebuf a cptrd,ebuf' v c1d,bufc0unt-1) ; 
ebuf*c:3ufcountd:=chr(0) ; 

(* NOW SHIFT OVER THE MARKERS THAT ARE STILL IN - 
NOTE THAT READJUST CAN'T BE USED HERE BECAUSE THE 
MARKERS WANT TO GET SHIFTED PAST PTR *) 
WITH PAGE2ER0 DO 

FOR i:=0 TO COUNT-1 DO 
IF PAGENCI3S-1 THEN 
BEGIN 

POFFSEU I 3 : =MAX ( 1 , POFFSETC I 3-PTR + l ) ; 
END; 
CURSOR :=CURSOR-PTR+i; 

END 
ELSE 

begin (* right *) 
ptr:=bufcount-i; 
save:=cursor; 

cursor :=min(cursor+200»bufcount-1) ; 
getleading; 

last:=linestart; 
repeat 

onepage:=max(ptr-1022,last) ; 
if onepage=last then 

stopmark:=onepage 
else 

stopmark:=scan(maxchar,=chr<eol)*ebuf*conepaged)+onepage+i; 
if stqpmark < ptr then 

BEGIN 

ok:=moveitout<stopmark.ptr) ; 
if ok then 

ptr:=stopmark-i 
else 

error(»ran out of disk room' inonfatal) ; 

END 
ELSE 

ok:=false; t 



193 



•94 



3733 


i 


32J3 


346 


3734 


1 


32:3 


356 


3735 


1 


32:3 


365 


3736 


i 


32:3 


332 


3737 


i 


32:3 


335 


3738 


l 


32:3 


399 


3739 


l 


32:2 


393 


5740 


l 


32:0 


399 


.3741 


l 


32 :o 


422 


3742 


l 


35:D 


1 


3743 


l 


35:d 


2 


3744 


l 


35:0 


2 


3745 


l 


35:D 


2 


3746 


1 


35:0 





3747 


l 


35:1 





3748 


l 


35:1 


2 


3749 


l 


35:2 


9 


3750 


l 


35:3 


9 


3751 


1 


35:3 


20 


3752 


l 


35:3 


28 


3753 


l 


35:3 


38 


3754 


l 


35:3 


47 


3755 


l 


35:3 


51 


3756 


l 


35:2 


58 


3757 


l 


35:o 


59 


3758 


l 


35 :o 


72 


3759 


l 


35:0 


72 


3760 


l 


35:0 


72 


3761 


l 


i:o 





3762 


l 


1:1 





3763 


l 


1:1 


39 


3764 


l 


1:2 


39 


3765 


l 


1:2 


50 


3766 


1 


1:2 


54 


3767 


l 


1:2 


64 


3768 


l 


1:3 


64 


3769 


l 


1:3 


69 


^>770 


l 


1:3 


72 


3771 


l 


1:3 


77 


3772 


l 


1:2 


87 


3773 


l 


1:1 


95 



UNTIL (0,^EPA3E=LAST) OR NOT OK J 

copyok: = (copyok and (COPYSTART>BUFCOUNT) ) OR 

(copyok and (copystart+copylength<last) ) 
bufcount:=last; 

EBJF*Ci3UFC0UN-n:=CHR<Q> ; 
CURSOR :=MIN(BUFCOUNT-l» SAVE) 

END 



END: 



PROCEDURE CHECKINDENT(*VAR CURSOR : PTRTYPE* ) ! 

{* CHECK TO MAKE SURE THAT THE LINE POINTED TO BY CURSOR HAS A LEGITIMATE 
(ACCORDING TO THE COMPILER. I.E. ONLY ONE DLE) INDENTATION PART. IF NOT 
THEN MAKE IT SO *) 
SEGIN 

SETLEADING; 

IF STUFFSTART-LINESTART>2 THEN (* POTENTIALLY TROUBLE! *) 
BEGIN 

moveleft(ebuf^cstuffstart3iebuf a clinestart+2 3»bufcount-stuffstart); 
read just (linestart,llnestart+2-stuffstart) ? 
cursor :=curs0r+li nest art+2-stuffstart; 
bufcount:=bufcount+linestart+2-stuffstart; 
ebjf*clinestartj:=chR(Dle) ; 
ebuf*clinestart+i::=chr(Blanks+32) 
end; 
end; 

(*$TE D I T R*) 

BEGIN (* SEGMENT PROCEDURE EDITOR *) 

INITIALIZE; GETLEADING; CURSOR :=MAX(CURSOR»STUFFSTART) 5 
REPEAT 

centercursor(trash»(screenheight div 2)+l»true); 

needprompt:=true; 

if userinfo.errblk>0 then p'jtsyntax; 

REPEAT 

home; clearline(O) ; 
editcore; 

if command=setc then environment 
else if command=copyc then copyfile 
until commano=qultc; 
until out; 
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102 SYSCOM^.^ISCINFO.r-JoBKEAK 

la? end; 

142 

3EGIN END. 
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l*iL PRINTER:*) 
(*SI GLOJALS.TEXT*) 
{ *$U-*) 
(*$S+*) 

(************ ********* ***#*****************************************) 

(* ♦ ) 

(* COPYRIGHT (C) 1973 REGENTS OF THE UNIVERSITY OF CALIFORNIA. ♦ ) 

<* PERMISSION TO COPY OK DISTRIBUTE THIS SOFTWARE OR DOCUMEN- *) 

(* TATION IN HARD OR SOFT COPY GRANTED ONLY BY WRITTEN LICENSE *) 

(* OBTAINED FROM THE INSTITUTE FOR INFORMATION SYSTEMS. *) 

(* *) 

(************** ********* + ***********************************;* #! (,,|c***) 

PROGRAM PASCALSYSTEM; 



UCSD PASCAL OPERATING SYSTEM 



RELEASE LEVEL: 1.3 

1.4 
1.5 



AUGUSTt 1977 
JANUARY, 1978 
SEPTEMBER, 1978 



♦♦♦♦♦♦♦fr****************************************) 

*) 
*) 
*) 
*) 

♦ ) 
*) 
*) 
*) 
*) 
*) 

♦ ) 
*) 
*) 
*) 
*) 



WRITTEN BY ROGER T. SUMNER 
WINTER 1977 

INSTITUTE FOR INFORMATION SYSTEMS 
UC SAN DIEGO, LA JOLLA, CA 



KENNETH L. BOWLES, DIRECTOR 

♦♦♦**♦♦**♦♦* + *♦**♦***♦♦♦********************:****) 

CONST 



MMAXINT = 32767; 
MAXJMIT = 12? 
MAXDIR = 775 
VIOLENG = 7! 
TIDlENG = 15; 
MAX5EG = 15; 
FoLKSlZE = 512; 



(♦MAXIMUM INTEGER VALUE*) 

(♦MAXIMUM PHYSICAL UNIT U FOR UREAD*) 

(♦MAX NUMBER OF ENTRIES IN A DIRECTORY^) 

(♦NUMBER OF CHARS IN A VOLUME ID*) 

(♦NUMBER OF CHARS IN TITLE ID*) 

(♦MAX CODE SEGMENT NUMBER*) 

(♦STANDARD DISK BLOCK LENGTH^) 
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41 J 1:D 1 Oir<:,L*< = 2: (*QiSK aodr of directory*) 

** ° i;0 ± AGt^lMIT = 500; <*MAX A3E FOR GDIRP...IN TICKS*) 

4 ~ , J 1:u 1 EOl = 15; (*END-OF-LINE.. .ASCII CR*) 

1+4 ° 1:} * CLE = 16; (*BLAMK COMPRESSION CODE*) 

^ ° t::} i N A M E _ L E , sj = 25; XLENGTH OF CONCAT ( VIDLENG* * I • . TIDLENG ) 1 

4& ° 1:u 1 FILL_LEf^ = 11; CMAXIMUM tt OF NULLS IN FILLER] 

47 o i:o i 

^8 o i:o i TYP £ 

<+9 u i:q i 

|jj '1 1:D x IORSLTWD = <IN0ERR0R,I3ADBL0CK,IBA0UNIT,IBA0M00EiITIME0UT» 

?* ° J :j X ILOsTUNITtlLOSTFILEi IBADTITLEtlNOROOMtlNOUNIT, 

?, u 1:0 x INOFlLEiIOUPFlLE.lNOTCLOSED.INOTOPENtlBADFORMAT, 

f 3 3 1:0 1 ISTRGOVFL)! 

54 i:d 1 

g| J J;^ X (*COMMANQ STATES. ..SEE GETCMD*) 

;? 7 ° HO 1 CMDSTATE = ( HAlTINIT, DEBUGCALL, 

^ ° 1:D * UPRO&NOU,UPROG'JOK,SYSPROG, 

59 ° 1: ^ 1 COMpONLYtCOMPANOSOtCOHPDEBUG* 

60 ° ISO 1 LlNKANDGOtLlNKDEBUG) ! 

61 i:d 1 

62 a i:d i 

63 3 i:j 1 

64 o i:d i 

65 o i:d 1 

66 o i:d 1 



29. 



(♦CODE FILES USED IN GETCMD*) 
SYSFILE = (ASSMBLER, COMPILER, EDITOR, FILER, LINKER) ; 

(♦ARCHIVAL INFO. ..THE DATE*) 



67 o 1:0 1 

° d 1!D 1 DATEREC = PACKED RECORD 

^ ? J! ° X MONTH! 0..12; <*0 IMPLIES DATE NOT MEANINGFUL*) 

'; Q l '° ' x 3AY: 0..31; (*DAY OF MONTH*) 

Li " } :D l year: 0..100 (*ioo is temp disk flag*) 

72 u 1S3 1 END (*DATEREC*) ; 

75 3 i:d 1 

It i } lD l (*VOLUME TABLES*) 

75 o no i unitnum = o..maxunit; 

76 l:D 1 MID = STRINGCVIDLENG3! 

77 o i:o 1 

1® IJO 1 (*DISK DIRECTORIES*) 

79 J 1!D 1 DIRRANGE = 0..MAXDIR; 

80 o i:d i tid = stringctidlengd; 

31 ° lso i full_id = stringcname.len:; 



62 


n 
J 


i:d 


l 


63 


a 


i:d 


i 


64 





i: j 


l 


35 





i:.d 


i 


6S 





1:3 


l 


87 





i:o 


l 


88 





i:d 


l 


39 





1 • r*. 
J. • u 


l 


90 





i:o 


i 


31 





i:d 


l 


92 





i:d 


i 


93 





i:d 


l 


94 





i:d 


l 


95 





i:o 


l 


96 





i:d 


l 


97 





i:d 


l 


98 





i:d 


l 


99 





i:d 


l 


100 





i:d 


l 


101 





i:d 


l 


102 





i:d 


l 


103 





i:o 


l 


104 





i:d 


l 


105 





i:d 


l 


106 





i:d 


l 


107 





i:d 


l 


108 





i:d 


l 


109 





i:d 


l 


110 





i:d 


l 


111 





i:o 


l 


112 





i:o 


l 


113 


a 


i:d 


l 


114 





i:d 


l 


115 





i:d 


l 


116 





i:o 


l 


117 





i:d 


l 


118 


G 


i:d 


l 


119 


J 


i:d 


l 


120 





i:o 


l 


121 


c 


i:d 


l 


122 





i:o 


l 



FILE_TA3LE = ARRAY CSYSFILED OF FULL_ID; 

FILFKlND = (UNTYPEDFILE»XDSKFILEiCOQEFILE»TEXTFILE, 

INFOFILE, DAT AFlLEtGR AFFILE i FOTOFILE.SECUREOIR) 5 



DIREiMTRY = PACKED RECORD 

dfirstblk: integers 
dlastblk: integer; 
case dfkind: filekind 

securedir, 

untypedfile: (*only in 

(FILLER1 ; 0..2048! 

dvid: vid; 
de0v8lk: integer; 



(*FIRST PHYSICAL DISK ADDR*) 
(*POINTS AT BLOCK FOLLOWING*) 
OF 



DIRC03.. .VOLUME INFO*) 

CFOR DOWNWARD COMPATIBILITY, 13 
(*NAME OF DISK VOLUME*) 
(♦LASTBLK OF VOLUME*) 



BITS} 



dnumfiles: dirrange? (*num files in dir*) 
dloadtime: integer; <*time of last access*) 
dlastboot: datereo; <*most recent date setting*) 

XDSKFlLE,CODEFILEtTEXTFlLE»lNFOFILE, 

datafile»graffile.fotofile: 

(filler2 : 0..512; cfor downward compatibility^ 

STATUS : BOOLEAN; CFOR FILER WILDCARDS^ 

dtid: tio; (*title of file*) 

dlastbyte: l.fblksize; <*num bytes in last block*) 



END 



daccess: 
(*direntry*) 



DATEREC) 



(*LAST MODIFICATION DATE*) 



DIRP = ^directory; 

DIRECTORY = ARRAY CDIRRANGE3 OF DIRENTRY; 

(*FILE INFORMATION*) 

CLOSETYPE = (CNORMAL,CLOCK,CPURGEiCCRUNCH); 
WINDOWP = "WINDOW* 

WINDOW = PACKED ARRAY C . . 3 OF CHAR; 
FI3? = "FIB; 

fib = record 

fwindow: windowp; (*user window .. .f~ t used by get-put*) 
feof.feoln: boolean; 
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F ST ATE: (I- JAHDWtFNEEDCHARiFGO 

frecsize: integer; (*i\ 3YT£S 

CASE FisOPEN: BOOLEAN OF 

TRUE: (FIS5LKD: 30QLEAM; (* 

funit: u i\i i t n u '"i ; (* 
fvid: vio; (* 

FREPTCNTi (* 

FNXT3LK, (* 

FMAXBLK: INTEGER? (* 
FMOOIFIEDIBOOLEAN; (* 
FHEADER: DIRENTRY;(* 
CASE FSOFTBUF: BOOLE 
TRUE: (FNXT3YTEiFM 

f3ufchngd: 
^buffer: pa 

ND (*FI3*) 5 



TCHAR) ; 
...0=>BLOCKFILE» 



1=>CHARFILE*) 



FILE IS ON BLOCK DEVICE*) 
PHYSICAL UNIT tt*) 
VOLUME NAME*) 

# TIMES F~ VALID W/O GET*) 
NEXT REL 3L0CK TO 10*) 
MAX REL BLOCK ACCESSED*) 
PLEASE SET NEW DATE IN CLOSE*) 
COPY OF DISK DIR ENTRY*) 
AN GF (*DISK GET-PUT STUFF*) 
AXBYTE: INTEGER; 
BOOLEAN; 
CKE.D ARRAY C . .FBLKSI2E 1 OF CHAR)) 



(*USER WORKFILE STUFF*) 



INFOREC = RECORD 

SYMFIBP,C0DEFI3P: fibp; 

errsym,errblk«errnum: integer; 
slowterm, stupid: boolean; 
altmode: char; 
gotsym,gotcode: boolean; 
workvid.symvid^codevid: vid; 
worktid,symtid»codetid: tid 
end (*inf0rec*) ; 



(♦WORKFILES FOR SCRATCH*) 
(♦ERROR STUFF IN EDIT*) 
(♦STUDENT PROGRAMMER ID!!*) 
(♦WASHOUT CHAR FOR COMPILER*) 
(♦TITLES ARE MEANINGFUL^) 
(♦PERM&CUR WORKFILE VOLUMES^) 
(♦PERM&CUR WORKFILES TITLED) 



segrang£ = 0..maxseg; 
segjesc = record 

diskaddr: integer; 

codeleng: integer 
end (*segdesc*) ; 



(♦CODE SEGMENT LAYOUTS*) 



(*REL BLK IN C0DE...A3S IN SYSCOM"*) 
(*fl BYTES TO READ IN*) 



(♦DEBUGGER STUFF*) 



3YTERANGE = 0..255; 

TRlCKARRAY = ARRAY CO. .03 OF INTEGER; (* FOR MEMORY DIDDLING*) 
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tfSC/IP = 



r- — A 



MSCW; 



(*i^ARK STACK RECOKD POINTER*) 



msc* = record 

statlink: mscwP; c*pqinter 
qynlimk: mscwp; (♦pointer 
msseg.msjtab: ~trickark ay ; 
msipc: integer; 
localoata: trickarray 
end (*mscw*) j 



TO PARENT mscw*) 
TO CALLER'S MSCW*) 



SYSCOMREC = 



{♦SYSTEM COMMUNICATION AREA*) 
(♦SEE INTERPRETERS. ..NOTE *) 
(♦THAT WE ASSUME BACKWARD *) 
(♦FIELD ALLOCATION IS DONE *) 



RECORD 

iorslt: iorsltwd; 
xeqerr; integer: 
sysunit: unitnum; 
bugstate: integer; 
gdiRp: dirp; 
lastmp,stkbasetbombp: 



(♦result of last 10 call*) 
(♦reason for execerror call*) 
(♦physical unit of bootload*) 
(♦debugger info*) 

(♦global dir pointertsee volsearch*) 
mscwp; 



INTEGER; 

(♦WHERE XEQERR BLOWUP WAS*) 

(♦MORE DEBUGGER STUFF*) 

OF INTEGER? 

(♦DRIVERS PUT RETRY COUNTS*) 

83 OF INTEGER; 



memt0p,seg,jta3: 
bombipc: integer; 
hltline: integer; 
brkpts: array co. .33 
retries: integer; 
expansion: array co., 
hightime,lowtime: integer; 
miscinfo: packed record 

nobreakt stupid »slowterm» 

hasxycrt,haslccrt,has85l0a»hascl0ck: boolean; 

userkind:(normali aquiz* bookert pquiz) 
end; 
crttype: integer; 
crtctrl: packed record 

RLF,NDFS»ERASEEOL.ERASEEOS» HOME i ESCAPE: CHAR 5 

backspace: char; 

fillcount: 0..255; 

clearscreen. clearline: char? 

prefixed: packed array co. .83 of boolean 

END; 
CRTINFO: PACKED RECORD 
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VAR 



WIDTH, HEIGHT: INTEGER; 

RIGHT, LEFT, DOrtfJ, UP: CHAR; 

SADCHf CHARDELt STOP, BREAK i FLUSH i EOF: CHAR; 

altmooe.linedel: char; 
3ackspace»etx, prefix: char; 

prefixed: PACKED ARRAY CO. .133 of boolean 
end; 
segtable: array csegrange3 of 

RECORD 

codeunit: unitnum; 

CODEDESc: SEGDESC 
END 
END <*SYSCOM*); 



MISCINFOREC 



= RECORD 

msyscom: 

END! 



SYSCOMREC 



^SYSCOMREC? 

ARRAY CO. .53 OF FIBP; 



syscom: 

GFILES: 

userinfo: inforec! 
emptyheap: ^integer 
inputfib,0utputfib» 
systerm,swapfib: fi 
syvid.dkvid: vid; 
thedate: DATEREC; 
debuginfo: ^integer 
state: cmdstate; 
pl: string; 
ipot: array co, .43 
filler: stringcfill 
digits: set of • o , » 
unitable: array cun 

RECORD 

livid: 

CASE 
TRU 
END (*U 
FILENAME : FILE.TAB 



BP; 



OF INTEGER; 
-LEN3; 



(♦MAGIC PARAM...SET UP IN BOOT*) 
(♦GLOBAL FILESt 0=INPUTt l=OUTPUT*) 
(♦WORK STUFF FOR COMPILER ETC*) 
(♦HEAP MARK FOR MEM MANAGING^) 
(♦CONSOLE FILES. ..GFILES ARE COPIES^) 
(♦CONTROL AND SWAPSPACE FILES^) 
{♦SYSUNIT VOLID & DEFAULT VOLID^) 
{♦TODAY. ..SET IN FILER OR SIGN ON^) 
(♦DEBUGGERS GLOBAL INFO WHILE RUNIN^) 
(♦FOR GETCOMMAND^) 

(♦PROMPTLINE STRING. ..SEE PROMPT^) 
(♦INTEGER POWERS OF TEN*) 
(♦NULLS FOR CARRIAGE DELAY*) 



itnum3 of (♦o not used+) 

vid; (♦volume id for unit*) 
uisblkd: boolean of 
e: (ueovblk: integer) 

NITABLE*) ; 
LE; 
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264 ( * 

264 (* SYSTEM PROCEDURE FORWARD DECLARATIONS *) 

264 (* THESE ARE ADDRESSED BY OBJECT CODE... *) 

264 (* DO NjT MOVE WITHOUT CAREFUL THOJGHT *) 
264 

1 PROCEDURE EXECERROR; 
1 FORWARD 

FiNiKVAR f: fib; window: windowp; recwords: integer); 



•*) 



FRESETUAR F: FIB) ; 



1 PROCEDURE 

4 FORWARD 

1 PROCEDURE 

2 FORWARD 
1 PROCEDURE FOPEN(VAR F.* FIB; VAR FTITLE: STRING; 

3 fopenold: boolean; junk: fibp); 

5 FORWARD 
FCLOSEUAR F: FIB; FTYPE: CLOSETYPE); 



fgetcvar f: fib) ; 

FPUT(VAR F: FIB) ; 



1 PROCEDURE 
3 FORWARD 

1 PROCEDURE 

2 FORWARD 

1 PROCEDURE 

2 FORWARD 
1 PROCEDURE XSEEKi 
1 FORWARD; 

3 FUNCTION FEOFUAR F; FIB); BOOLEAN; 

4 FORWARD 
FEOLNtVAR F: FIB): BOOLEAN; 



3 FUNCTION 

4 FORWARD 
1 PROCEDURE 

3 FORWARD 
1 PROCEDURE 

4 FORWARD 
1 PROCEDURE 
1 FORWARD 
1 PROCEDURE 
1 FORWARD 
1 PROCEDURE 

3 FORWARD 
1 PROCEDURE 

4 FORwARD 
1 PROCEDURE 



FREADINTCVAR F; FIB; VAR I: INTEGER); 

FWRITEINT(VAR F: FlBJ ItRLENG: INTEGER); 

XREADREAL; 

XWRITEREAL; 

FREADCHAR(VAR F: FIB; VAR CH: CHAR); 

FWRITECHAR(VAR f: FIB; CH: CHAR; RLENG: INTEGER); 

FREADSTRIN3(VAR F: FI3; VAR S: STRING? SLENG: INTEGER); 



4 FORWARD. 

1 PROCEDURE FWRITESTRlNGtVAR F! FIB; VAR S; STRING; RLENG; INTEGER); 
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304 
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19; 

20 

20: 

21 

21; 

22; 

22; 

23; 

23: 

24; 

24; 

25; 

25; 

261 

26: 
27; 
27; 
28: 
28; 
28; 
29; 
29; 
29; 
29: 
29: 
30: 
30: 
30: 
31; 
31; 
32: 
32: 
33; 
33: 
33: 
34: 
34; 
35: 
35; 
36; 
36: 



4 FORWARD 

1 JROCEDJRI 

5 forwar: 

i procedure 

?. forward 

1 PROCEDURE 

2 FORWARD 
1 PROCEDURE 

4 FORWARD 
1 PROCEDURE 

5 FORWARD 
1 PROCEDURE 
5 FORWARD 
1 PROCEDURE 



fwrite3ytes(vah f; fi3; var a: window; rlengi aleng! integer); 

fr£adln(\/ar h ' fib) ; 

fwritelnwar f: fib> ; 

sconcatcvar oestisrct string; destleng: integer)! 

sinsertcvar srcdest: string*. destleng , insinx: integer); 

scopy(Var src,dest: string; srcinx,copyleng: integer); 

sdeleteivar uest: string; dellnx i delleng: integer); 



4 FORWARD. 
3 FUNCTION SP0S(VAR TARGET.SRC: STRING): INTEGER; 

5 FORWARD* 
3 FUNCTION FBLOCKIOUAR F: FIB! VAR A: WINDOW; i: INTEGER*. 

6 NBLOCKS,RBLOCK: INTEGER; DOREAD: BOOLEAN): INTEGER; 

9 FORWARD; 

1 PROCEDURE FGOTOXY(X»Y: INTEGER); 

3 FORWARD; 

3 

3 (* NON FIXED FORWARD DECLARATIONS *) 

3 

3 FUNCTION V0LSEARCH(VAR FVID: VIO*. LOOKHARD: BOOLEAN! 

5 VAR FDIR: DIRP): UNITNUM; 

6 FORWARD; 

1 PROCEDURE WRITEDIR(FUNIT: UNITNUM; FDIR: DIRP); 

3 FORWARD; 

3 FUNCTION DIRSEARCHWAR FTID: TID*. FINDPERM: BOOLEAN; FDIR: DIRP): DIRRANGE; 

6 FORWARD; 

3 FUNCTION SCANTITLEIFTITLE: STRING; VAR FVID: VID; VAR FTID: TID; 

6 VAR FSEGS: INTEGER; VAR FKIND: FILEKIND): BOOLEAN; 

49 FORWARD 

DELENTRY(FINX: DIRRANGE; FDIR: DIRP)! 



1 PROCEDURE 

3 FORWARD 
1 PROCEDURE 

4 FORWARD 
1 oROCEDURE 
1 FORWARD 



INSENTRYtVAR FENTRY: DIRENTRY; FINX: DIRRANGE; FDIR: DIRP); 

HOMECURSOR; 



328 37CD i PROCEDURE CLEARSCREEN 5 

329 37:D i FORWARD; 

330 38:0 i PROCEDURE CLEARLINE; 

331 38:D 1 FORWARD; 

332 39: ~j 1 PROCEDURE PROMPT; 

333 39ID 1 FORWARD; 

334 . 10:D 3 FUNCTION SPACEWAIT ( FLUSH: BOOLEAN): BOOLEAN; 

335 40:D 4 FORWARD; 

336 «fl:D 3 FUNCTION &ETCHAR ( FLUSH: BOOLEAN): CHAR! 

337 4i:D 4 FORWARD; 

338 42!D 3 FUNCTION FETCHDIR (FUNIT:UNITNUM) : BOOLEAN; 

339 42:D 4 FORWARD; 

340 43:D 1 PROCEDURE COMMAND; 

341 Q 43:D 1 FORWARD; 

342 43:0 1 

343 43:0 1 (*$I GLOBALS.TEXT*) 

344 43:D 1 

3<l5 1 ISO 1 SEGMENT PROCEDURE YALOE( INNtOWWT; FIBP); 

3Jf7 1 ISO 3 (* COPYRIGHT (C) 1978 REGENTS OF THE UNIVERSITY OF CALIFORNIA. *) 

3 ^ 8 1 ISO 3 (* PERMISSION TO COPY OR DISTRIBUTE THIS SOFTWARE OR DOCUMEN- *) 

349 1 18D 3 (* TATION IN HARD OR SOFT COPY GRANTED ONLY BY WRITTEN LICENSE *) 

350 1 1!D 3 (* OBTAINED FROM THE INSTITUTE FOR INFORMATION SYSTEMS. *) 

351 l l «D 3 {****************************+***************+****************+**+***) 

352 1 l.'D 3 

353 1 ISO 3 (* YALOE * YALOE * YALOE * YALOE * YALOE * YALOE * YALOE * YALOE * 

354 1 1ID 3 * THIS TEXT EDITOR IS BASED ON THE COMMAND STRUCTURE 

355 1 i:D 3 * OF THE RT-11 SYSTEM TEXT EDITOR. INITIALLY STRUCTURED 

356 1 1SD 3 * AND WRITTED BY RICHARD KAUFMANN AND GREG DAVIDSON, 

357 1 ISO 3 * LATER MODlFIEDt ENHANCED, AND QUICKENED BY KEITH SHILLINGTON. 

358 1 i:D 3 * RELEASED CONTINUOUSLY FROM EARLY JUNE 1977, 

359 1 ISO 3 * LATEST FIXES BY ROGER SUMNER FOR 1.3 8-AUG-77 

360 1 i:D 3 * ll-AUG-77 KEITH SHILLINGTON BACKSPACING CHANGES 

361 1 llD 3 * 13-SEP-77 KAS & RTS ALPHA LOCK AND BACKSPACE FIX 

362 1 1:0 3 * 24-SEP-77 RTS REMOVES ALPHA LOCK. ..PUT INTO 1.3B INTERP 

363 1 i:D 3 * 7-0CT-77 MADE A NON-SYSTEM PROGRAM. . ,RSK DYNASTY TAKES OVER 

364 1 ISO 3 * 9-FE3-78 BUGS ABOUT HEAP REMAIN. ..1.4 OUT THE DOOR ANYWAY 

365 1 i:D 3 * SYSTEM WORKS OK WITH DIRTY FIX IN WRITEDIR! 

366 1 ISO 3 * YALOE * YALOE * YALOE * YALOE * YALOE * YALOE * YALOE * YALOE *) 

367 1 i:o 3 

368 1 1:d 3 CONST 
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CHANGING 



RET = 13; TAB = 9; 

CTRLX = (*G30O*) 2t 

DC1 = (*0210*) 17 

EXECSIZE = 1000; 

MAXMAC =9; (* 

SHIFT = 15; 
TYPE 

FILEBUF = PACKED ARRAYC . . 1023H OF CHAR; 

COMARRAY = PACKED ARRAYC . . 993 OF CHAR; 

BUFCHUNK = PACKED ARRAYC . .9993 OF CHAR; 
VAR 

IiJ.ENDPOSiCURSOR: INTEGER! 

bufsize,bufend: INTEGER; 

equallength: integer' 

esc: char* 

ctrlu: integer; 

backer: char; 

exec: *comarray; 

buf: *3ufchunk5 

macros; arrayi0..maxmac3 of 

RECORD 

LGTH: INTEGER; 
EXEC: "COMARRAY 

end; 
option: packed record 
listsize: o # ,ioo; 

ONOFF: BOOLEAN 
END; 

iofile: file; 
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THIS HAS IMPACT ON THE CODE... *) 



FUNCTION COMMAND! BOOLEAN; 



forward; 
integer; 



function min(a,b:integer): 

BEGIN 

if a>b then min := b else min := a 
end; 

function newfin: boolean? (* true if error occurs *) 
label i; 

VAR 

nblocks,stashsize,stashedat: integer; 
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STASHCURSORiNPASES* I tNEXT: integer: 

diddled: boolean 
3EGIN 

NEWFIN := false; 

IF BLOCKREAD(IOFlLE»It0t2) = THEN BEGIN (* OK *) 

STASHCURSOR := CURSOR; 

stashsize := ENDPOS - CURSOR; stashedat := BUFEND-STASHSIZE; 

IF (STASHEDAT > cUKSCR) THEN (* THERE IS ROOM *) 

MO VERIGHT(BUF~C CURSOR 3 »BUF A C STASHEDAT 3, STASHSIZE) 
ELSE 

BEGIN 

rtRlTELNtOUTPUT.'NOT ENOUGH SPACE' )? 
NEWFIN := true; 
GOTO li 

END; 
DIDDLED := FALSE; 
IF ODD(CURSOR) THEN BEGIN 

DIDDLED := true; 

cursor :s cursor +i; 
end; 

nblocks := (stashedat - cursor) div 512; 
nblocks := blockread<loflle»buf*ccursor3tnblqcksm 
if (not eof(iofile)) or (ioresult <> 0) or (odd(nblocks) ) then begin 

close(iofile); 

writeum output,' not enough space 1 ); 

CURSOR := STASHCURSORS 

NEWFIN := TRUE; 

GOTO U 
ENDS 

NPAGES := NBLOCKS OIV 2? 
IF DIDDLED THEN (* UGH *) BEGIN 

cursor := cursor -l; 

HOVELEFT(BUF' s CCURSOR + lD f BUF A i:cURSORDtNPAGES*1024); 

end; 

next := cursor; 

while npages > do begin 

npages := npages -1; 

cursor := cursor +1023; 

next := next +1024; 

i := scan(-1024«ochr(0) i3uf^ccursor3) ; 

CURSOR := CURSOR +1 +i; (* POINT AT FIRST NUL *) 
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308 

4=>1 1 4:5 2iG IF :, PAGES > THLN MGVELEFT ( BUF~C F-JEXT3, BUF~L CURSOR 3 , 1024 ) ; 

4b2 i <t:«4 274 €i,q; 

455 1- u ^3 27i i: ( * T.IIS IS ,%<kEKE THE >vO'J,4Q IS CLOSED AND hEALED *) 

454 1 4;3 27b CLGSildOFILU; 

45b 1 4:3 ^52 MOVLUcFTCJUF^CSTASHECATJiBUF^CCURSOKD.STASHSlZE) ; 

45i 1 4:3 2G.9 E^DP-n; := STASHSIZE +CURSOKJ 

457 1 413 294 BUF^C I NDPOS 3 := CHK(O)! 

458 1 4:3 233 CURSOR := STASHCURSOR; 

459 1 4:2 301 END; 

460 1 4:0 301 end; 

461 1 4:0 320 

462 1 5:D 1 PROCEDURE INITIALIZE; 

463 1 5:D 1 vAR 

464 l 5:d i bufmaker: -bufchunk; 

465 i 5:d 2 spacemaker: -comarray; 

466 i 5:d 3 here: -integer; 

467 i 5:0 4 limit: integer; 

468 i 5:o 5 test: boolean; 

469 1 5:0 SEGIN 

47o i 5:1 o writeOutput,»yaloe:' > ; 

471 1 5:i 16 IF NOT SYSCOM^.MISCINFO.SLOWTERM THEN 

472 1 5:2 27 WRIT£(0UTPUT» 

473 1 5:2 27 ' - ? <ESCXESC> FOR DETAILS'); 
^74 1 5:1 64 WRITELN(OUTPUT) ; 

475 1 5:i 70 NEW(BUF); (* BASE OF THE BUFFER *) 

476 1 5:i 77 BUFSIZE := SIZEOF ( BUFCHUNK ) 5 

477 1 5:i 82 LIMIT := ORD ( SYSCOM^.LASTMP ) ; 

478 1 5:i 88 REPEAT 

479 1 5:2 38 MARK(HERE); 

430 1 5:2 92 TEST := ((LIMIT - ORD ( HERE ) X5000 ) AND ((LIMIT - ORD (HERE ) ) >0 ) ; 

481 I 5:2 107 IF NOT TEST THEN 

432 1 5:3 111 BEGIN 

483 1 5:4 111 NEW(BUFMAKER) 5 

484 1 514 118 BUFSIZE := BUFSIZE +SIZEOF ( BUFCHUNK ) 
^35 1 5:3 122 END; 

486 1 511 125 UNTIL TEST; 

487 1 5:1 128 IF BUFSIZE < THEN BUFSIZE : = 32000; 

488 1 5:1 138 NEW(EXEC); 

439 1 5:i 143 FOR I := 1 TO 9 DO NEW ( SPACEMAKER ) ? (* CREATE SPACE FOR BASIC COMMAND *) 

4^0 1 5:i 166 FOR I : = TO MAXMAC DO 

491 1 5:2 177 MACROSCID.EXEC := NIL; 
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CURSOR := o; enopos := 0; 
OPTION. ONOFF := FALSE; 
bJFENO := 3UFSIZE; 
I := 0; 

ACR := CHR(RET) J 

BACK := SYSCOM".CRTCTRL. BACKSPACE; 
ESC := SYSCOM^.CRTINFO.ALTMODE; 
CTRLU := ORO(SYSCOlw".CRTINFO.LINEOEL) i 
WITH USERINFO DO 
IF GOTSYM THEN BEGIN 

OPENOLD(IOFILE»CONCAT(SYHVIDt »:• .SYMTID) ) ; 

IF NEriFlN THEN 

BEGIN WRITELN< OUTPUT, 'LOST WORKFILE SOURCE*) 

GOTSYM := FALSE 
END 
ELSE BEGIN 

WRlTE(OUTPUT,»WORKFILE »)! 

IF LENGTH(WORKTID) > THEN 
WRlTE<OUTPUT,WORKTID»» •); 

WRlTELiM(OUTPUT,»READ IN»); 
END 

end else begin 
endpos := o; buf^co] := chrcqj; 

WRlTELN<OUTPUTt»NO WORKFILE TO READ*) 5 
END? 

cursor := o; 
equallength := o; 

END: 



1 1 



PROCEDURE newoutlook; 
WAR IriNTEGER; 

stashcursor: integer; 
p: "integer; 
com: ~filebuf; 

BEGIN 

STASHCURSOR := CURSOR; 
MARK(P) S 

NEW (COM) ; 

FILLCHAR(COM' X C:0:,10 24,CHR<0) ) ; 

CURSOR := 0! 
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533 1 oil 25 IF i3LOCKwKlTt:(lUFXl.EtCOM%2) = 2 THEN 

534 1 6:2 44 WHILE (CJRSOK + 1023) < EfjDPOS DO BEGIN 

535 1 614 53 I := SCAN(-1022. = CHR(RET), 9UF"CCURS0R +1022:)! 

oio 1 6:4 70 rJ|OVE:LEFT(BJF A CCUKSOR3, C0^ A , 1023 + 1) ; 

537 1 614 61 FlLLCHAK<COV*Cl023+i:tABS(I)+l«CHR(0>); 

53a 1 614 ?4 IF BLOCKURITE(IOFILE»COM A »2> <>2 THEN BEGIN 

53? 1 616 113 RlLEASE(P)! 

54Q 1 6:6 117 yRlTELNiOUTPUTt 'OUTPUT FILE ERROR: HELP*)! 

541 1 6:6 156 CLOSE(IOFILE) ; 

542 1 6:6 162 EXIT(COMMANO); 

543 1 6J5 166 ENj; 

544 1 614 166 CURSOR := CURSQR+1023+I ; 

545 1 6!3 175 END! 

546 1 6:1 177 IF (CURSOR < ENDPOS) THEN BEGIN 

547 1 6:3 182 FlLLCHAR(BUF'*CENUPOS3»l02f-(ENDPOS-CURSOR)fCHR{0))l 

548 1 6:3 194 MOVELEFT(BUF"CCuRS0RDiCOM a ,102h) ; 

549 1 6:3 203 IF BLOCKWRITE ( IOFILE iC0PTt2 ) <>2 THEN BEGIN 

550 1 6:5 222 RELEASE(P)? 

551 1 6:5 226 WRITELN ( OUTPUT* 'OUTPUT FILE ERROR. HELP!'); 

552 1 6:5 267 CLOSE ( IOFILE ) ; 

553 1 6:5 273 EXIT (COMMAND) 5 

554 1 6:4 277 end; 

555 1 6:2 277 END? 

556 1 6:1 277 RELEASE(P); 

557 1 6:i 281 CLOSE(IOFILEtLOCK) ! 

558 1 6:i 287 CURSOR := STASHCURSOR; 

559 1 6:0 290 END; 

560 1 6:0 306 

561 1 7:D 1 PROCEDURE CLOSETHEWORLD ( VAR CH: CHAR); 

562 1 7:0 2 VAR 

563 1 7:0 2 LTITLE : STRINGC293! 

564 1 7:D 17 EXITSET: SET OF 'A'.^Z'S 

565 1 7:0 BEGIN 

566 1 7.*1 EXITSET := C »E • . 'E' . f U» , 'U* , *R» t •R* 3? 

567 1 7:i 25 REPEAT 

568 1 7:2 25 IF NOT (CH IN EXITSET) THEN BEGIN 

569 1 7:4 36 CLEARSCREEN5 

570 1 7:f 39 PL:='QUIT: U<PDATE WORK FILE. E(XIT WITHOUT UPDATE. R(ETURN TO EDITOR*! 

571 1 7:4 111 PROMPT; READ ( INPUT . CH ) ; WRITELN ( OUTPUT ) 

572 1 7:3 127 END! 

573 1 7:2 127 IF (CH =, UM OR (CH= , U») THEN 



b J, J * l 7:i 133 wl TH JSERIfJFO LG BEGIN 

b7 ' J x 7:5 1^3 lTIT|_EL := »*SYSTEM. wRK. TEXT' ; 

l*° 1 7: - lbl DoEN.-JEn(IOFlLELiLTlTLE); i-JEwOUTLOQK ! 

HI } 1 : ~ 172 I* 1 ? *£ GET HERE THEN FILE IS LOCKED ON DISK QK*) 

Hi t Z: b 172 symvio := srviu; symtid := 'system. wrk. text* , gotsym := truej 

*' 207 LTITlE := •*SYSTEM.wRK.CODE»; 

IV; } Z :5 23 ° 0PEN0LD(I0FILE. LTITLE); CLOSE ( IOFILE , PURGE ) ; 

zVl x 7:b 2<+5 30TCGDE := FALSE; CODETID := " 

532 i lm 252 END 

583 1 7:i 257 UNTIL CH IN EXITSETJ 

534 1 7:0 267 fnd; 

585 1 713 282 

586 1 710 2S2 

537 I 85L i PROCEDURE PROMPTS? 

588 1 8.-C 1 V AR 

585 i 8:D 1 HERE: ^INTEGER! 

590 1 8:0 3EGIN 

591 1 8:i MARK(HERE); 

5 9 2 i s:i <+ clearscreen; 

i??, 3 l 8:1 7 ^RlTELN(OUTPUT,'YET ANOTHER LINE ORIENTED EDITOR.')! 

S9(+ 1 811 56 WRITELN(OUTPUT) ; 

595 1 8:i 62 WRlTELf\j(OUTPUT» 

11* J f'' 1 62 'ADVANCE BEGINNING CHANGE DELETE GET INSERT JUMP'); 

HI } 8|1 131 WRITELN(OUTPUT,'KILL LIST MACRO <DEFINITI0N> NOW <MACRO EXECUTIONS ) ; 

til i =:, ?S2 WRITELN(0UTPUT,'QUIT <ESC U P DATE> READ <FILENAME> SAVE UNSAVE VERIFY'); 

J*l X 8 .1 272 WRITEL'J(0UTPUT, 'WRITE <FILENAME> EXCHANGE ?ELP*); 

6 l 8:1 32 ° WRITELN(OUTPUT,'CTRL-X (CAN) TO CANCEL COMMAND INPUT.') 5 

b01 1 8:i 373 WRITELM(OUTPUT); 

G ®1 X 8:i 379 WRlTELrj(OUTPUT.'THE MACROS YOU HAVE DEFINED ARE: 1 ); 

603 1 e:i 427 WRITE(0UTPUT,' - •)? 

60£+ i a:i 4^0 for i := o to maxmac do 

^ 5 X 8:2 451 IF MACROSCID.EXEC <> NIL THEN 

60& 1 fi :3 461 WRIT£(0UTPUT.I,' - ♦); 

° 07 i 8:i 489 writel.m(Output) ; 

*°S J 8:1 l+ 95 WRITE(OUTPUT,'YOUR TEXT BUFFER IS '.BUFSIZE,' BYTES. »,ENDPOS>; 

Z,Z J" 8:1 559 «RITELN{0UTPUT.» OF WHICH ARE FILLED. LEAVING • .BUFSIZE-ENDPOS) ; 

"? 1 8,:L S15 WRITE(0UTPUT,»Y0UR "SAVE" TEXT IS • .SUFSIZE-BUFEND . • BYTES'); 

bii i e:o &7i end; 

612 i a:o 6BS 

613 1 9:0 1 PROCEDURE INCOMMAND; 

6 14 i 9:D 1 LABEL 1,2: 
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9:o 



9 
9: 

Q 

9; 
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9; 
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55 
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76 
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32 
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«/AR OiJEt 

ch: cm 

FACTOR 

CHDtu: 

CRTESC 

SL3/i , n 

COi'JTRO 

;;EGI** 

FILLCH 

FACTOR 

WITH S 

cJESl 

SL 

CH 

CR 

UP 

EE 

end; 

WASBS 

ch : = 
I := o 

WARNED 
ONEESC 
READ(K 
IF EOL 
WHILE 
BEGI 
IF 



ON 
IF 
IF 



SC»WAMjEj: DQGLEAii; 

.v> ; 

t T : INTEGER ; 
CHAR; 

»jp»leol: cha^? 

ASoS; BOOLEAN? 
ls: SET OF char; 

A- (EXEC *• EXECS I ZE, ESC) ; 
: = u ; 

Y3 COM", CRTCTRL»MISC INFO DC 

,'j 

3w := (backspace = chr(0))5 (* no control *) 
^[l ;= crtinfo.chardelj 
tesc := escape; 

:= rlf; 
tl := eraseeol 

:= false; 
• • ; 

t 

:= false; 
:= false; 

EY30ARD,CH) ; 

\l( KEYBOARD) THEN CH := ACR5 
(CH <> ESC) OR NOT ONEESC DO 
N 
CH = CHR(SHIFT) THEN 

IF SYSLOVP.MISCINFO.HAS3510A THEN (*KAS 8/15*) 

IF FACTOR = 128 THEN FACTOR := ELSE FACTOR := 128; 
EFJSC := (CH = ESC) ; 
ONEESC THEN GOTO 1; 
Z^ - CHDEL then 

IF (I > 0) THEN 
BEGIN 

I := PRED(I) 5 
IF SLOW THEN 

IF WASBS THEN WRITE ( OUTPUT , EXEC'C I 3 ) 
ELSE WR ITE( OUTPUT, ♦%♦ ,EXEC^LID) 
ELSE 

IF EXEC A Ci: = CHR(TAB) THEN 
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END 



FOR T := 1 TO 3 DO rtRI TE ( OUTPUT , BACK ) 
ELSE WRITE (OUTPUT, SACK,' »,BACK); 



IF (CH = CHR(ClRLU) ) THEN 

IF SLOW THrhj 

WR I TELN( OUTPUT* • <ZAP» ) 
ELSE 
BEGIN 

WRITELNCOUTPUTf CRTESCiUP) ; 
WRITE(OUTPUT.CRTESCEEOL) ; 
END; 

WHILE (I > 0) AND (EXEC~CI3 <> ACR) DO I := PRED(I); 
IF I <> THEN I ;= S'JCC(I) ELSE WRITE (OUTPUT, »*• ) 

END 
ELSE 

IF (CH < » •) THEN 
3EGIN 

IF ORD(CH) IN CRET.TASiDCl] THEN 
3EGIN 

i: exec a cid := ch; 

i := succd) ; 

IF ONEESC THEN WRITE< OUTPUT, •$• ) 

ELSE IF ORQ(CH) = DC1 THEN WRITE (OUTPUT. CHR ( 7) ) 
ELSE WRITE(OUTPUTtCH) 
END; 

IF CH = CHR(CTRLX) THEN 3EGIN 

I := o; 

WRITELN(OUTPUT) ; 
EXIT(INCOMMAND) 

END 

END 

ELSE 

IF (CH <> CHDEL) AND WAS3S THEN 
BEGIN 

if slow then write ( output ,♦%») ; 
write(output.ch) ! 
exec*ci3 := ch; 
i := succd) 

END 
ELSE 



313 



697 


i 


9:6 


'4 96 


69S 


1 


9:7 


511 


699 


1 


9:6 


511 


700 


1 


9:a 


519 


731 


1 


9:o 


523 


702 


1 


9:7 


526 


705 


1 


9:3 


528 


704 


1 


9:3 


533 


705 


1 


9:4 


542 


706 


1 


9:6 


551 


707 


1 


9:6 


614 


708 


* 


9:6 


622 


709 


1 


9:3 


627 


710 


1 


9:7 


634 


711 


1 


9:7 


636 


712 


1 


9:9 


641 


713 


1 


9:9 


649 


714 


1 


9:o 


654 


715 


1 


9:a 


658 


716 


1 


9:5 


658 


717 


1 


9:4 


658 


718 


1 


9:6 


671 


719 


1 


9:7 


671 


720 


1 


9:7 


708 


721 


1 


9:6 


711 


722 


1 


9:3 


711 


723 


1 


9:3 


719 


724 


1 


9:3 


732 


725 


1 


9:4 


737 


726 


1 


9:2 


740 


727 


1 


9:1 


744 


728 


1 


9:i 


758 


729 


1 


9:o 


763 


730 


1 


9:o 


792 


731 


1 


9:o 


792 


732 


1 


2:d 


3 


733 


1 


2:d 


3 


734 


1 


2:d 


4 


735 


1 


2:d 


5 


736 


1 


2:d 


6 


737 


1 


2:d 


10 



314 

IF (CH <> CHDE1L) AND (Crl >= ' • ) AND (CM <> CHR(CTRIU)) THEN 

-EG IN 

wfUTE(OUTPUT»CH) ! 
EXECLI3 := CH! 

I := succ(i) 

end; 

WASBs != <CH = CHOEL) ; 

IF I >= (EXECSIZE - 80 <*WARNING*>> THEN 
IF I > (EXECSIZE - 2) THEN REPEAT 

i«RlTELN(OUTPUTt»COMMAND 3UFFER FULL. TYPE <ESC> <ESC> OR C*X>.»M 

READ{KEY30ARD»CH) ; 

IF CH=CHR(CTRLX) THEN BEGIN 

I := 0; EXlTCINCOiWAMD) 
END ELSE 

IF CH = ESC THEN BEGIN 
READ(KEYBOARO,CH) ! 
IF CH = ESC THEN 
EXIT(INCOMMAND) ; 
ENDJ 
UNTIL FALSE 

ELSE IF NOT WARNED AND (CH = ACR) THEN 
BEGIN 

writeln(outputt»please finish' , chr ( 7 )( * bell *)); 
warned:=true; 

end; 

READ(KEYBOARDtCH) ; 

IF EOLN(KEYBOARD) THEN CH := ACR! 

IF CH >= ' • THEN 

CH := CHR(ORD(cH)+FACTOR) 

end; 

WRITELN(OUTPUTi •$» ) 5 
i:=I-l; 

end; 

function c0mmand(*: boolean *)? 

VAR RC0UNT:iNTEGER; 

thisch: char; 

neg:soolean; 

number: set of •o , ». , 9 , j 
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PROCEDURE SYNTAX<ERrtCH: CHAR); 
bEGlN 

WRlTELM(OUTPUTtERRCHt» : IS IN ERRORt COMMAND STOPPED.'); 
EXlT(COMMAiMD) 5 

cnd; 

PROCEDURE LIiMEPLACE(VAR PTR: INTEGER; N: INTEGER); 

var 1: integer; 

3EGIN 

PTR := cursor; (* a nice place to START *) 

IF (N <= 0) THEN (* LOOK BACK *) BEGIN 
REPEAT 

PTR := PTR -1; 

I := SCAN(-(PTR + D i=ACRtBUF~CPTRI]) ; 

PTR := PTR +1; 

N := succtN) ; 

UNTIL (N > 0) OR (PTR < 0); 
PTR := sUCC(PTR); 
END ELSE REPEAT 

I := SCAN(ENDPOS-PTR-i,=ACR«BUF A CPTR3) ; 

PTR := PTR+I+l; 

n := n -1; 
until (n=0) or (ptr = endpos); 
end; 

procedure deletestuff; 

VAR 

count: integer; 

BEGIN 

IF (RCOUNT = 0) THEN 
BEGIN 

LlNEPLACE(COUNT.O) ; 

rcount := count - cursor! 

end; 
count :=cursor+rcount; 
IF RCOjnT<0 then 

BEGIN 

IF CQUNT<0 THEN COUNT := 0; 

MO VEuEFTCBUF^C CURSOR D,BUF^C COUNT 3 »ENDPOS-CURSOR+l) ; 

ENDPOS:=ENDPOS-(cURSOR-COUNT) ; 
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ENDPOS := CURSUR; 3UF"CCURS0RD ;= CHR(O); 
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WELEFTtBUF'*!: COUNT 3, BUF~C CURSOR 3, ENDPOS-COUNT+1) 5 
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ENDPOS:=ENDPOS-( COUNT-CURSOR) 5 
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CURSOR := CURSOR + SCAN ( -CURSOR, =FIRST » BUF A CCURSOR3) ; 
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IF CURSOR <= THEN 
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HARDEND := TRUE; 
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cursor := emdpos; 
exit(finuit) 

END 

EfvD; 

MOVELEFT(eUF~CCUKSOR J, QUESTION 13, SIZE); 
FOUND := (QUESTION = PATTERN); 
CURSOR := CURSOR + DIR 
UNTIL FOUND 
END (* FINDIT *) 5 

BEGIN 

IF RCOJNT < THEN 
BEGIN 

RCOUNT := -RCOUNT; 
DIR := -1 
END 
ELSE DIR := l; 

u := J+i; 
size := o; 

FIRST := EXEC^CJII; 

WHILE EXEC^CJ +SIZE3 <> ESC DO SIZE := SIZE +1: 

IF SIZE >= SIZEOF(PATTERN) THEN 

M nS^ G r N WRITELN(OUTPUT,.FIND TOO LONG*)? EXITCCOMMAND ) END; 

patternc03 := chr(size); 
questioned := chr(size); 

HARDEND := FALSE; 
FOUND .*= FALSE; 
REPEAT 

findit; 

rcount := rcount -1 
until (rcount <= 0) or hardend; 
if hardend then 

BEGIN 

WRlTELN(OUTPUT f PATTERN, * NOT FOUND'); 

exit(command) 
end; 
if dir < then cursor := cursor +1 
else cursor := cursor +size -1; 
J := u +size; 
equallength := size 
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.njc ( * gutter *) ; 

procedure: INSCRTTCXT; 
V'AR 

SIZEijVER: '300LEAN; LENGTH* TE viP: INTEGFKI 
jEGIN 

sizeovep :- false; J := j+i; 

LENGTH := SCAN(I-J f = (ESC)iExECCJ3); 
TEMP := ENDPOS + LEiMGTH; 
IF (TEWP > 3UFSIZE) THEM 

BEGIN 

*/rlteln(output, 'insertion truncated. not enough space*); 

sizeover := true; 

length := bufsize-endpos; 

TEmip := BUFSIZE? 

end; 
if (temp > bufend) then 

BEGIN 

WRlTELN(OUTPUT,'"SAVE" AREA DELETED.') ! 

BUFEND := BUFSIZE; 
END? 

moverlghttbuf^c cursor 3 .buf'ccursor+lengthd* bufend- (cursor+length)) j 
m0veleft(exec a cj:,buf*ccurs0r3»length); 
endpos ;= endpos +length5 
cursor := cursor +length? 
equallength := length; 
if sizeover then exit(command) ; 
j 1= j +length? 
end (* insert new text *) ! 

procedure jump; 

BEGIN 

IF RCOUNT = THEN LINEPLACE( CURSOR . ) 
ELSE CURSOR := CURSOR + RCOUNT; 
IF (CURSOR<0) AND (RCOUNT<0) THEN CURSOR := 
ELSE 
IF (CURSOR<0) OR ( CURSOR>ENDPOS) THEN CURSOR := ENDPOS? 

end; 



PROCEDURE KILL; 
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VAK POSITION: INTEGER! 
BEGIN 

LINEPLACtCPOSITIONiKCOUNT) ; 
IF RCOjrjT< = THEN 

3 E S I hi 

"*OVELEFT(BUF'*CCURSORDtBUF*CPOSITIOND« (ENDPOS-CURSOR + 1) ) ; 
ENOPOS := ENDPOS - (CURSOR - POSITION); 
CURSOR := CURSOR - (CURSOR - POSITION); 

ELSE 
BEGIN 

moveleft<buf*cposltion3,b'jf'*ccursor3i cendpos-position+1) ) 5 
endpos :=■ endpos - (position - cursor); 
end; 
end; 



PROCEDURE LIST; 

VAR POSITION: INTEGER! 
BEGIN 

LINEPLACE(POSITION,RCOUNT) ; 

IF RCOUNT<=0 THEN 

UNIT^RITE<1(* CONSOLE: *), BUF~CPOSITlON3, CURSOR-POSITION) 

ELSE 

UNITWRITE(1(* CONSOLE: *) »BUF*CCURSORD, POSITION-CURSOR ) 

end; 



PROCEDURE MACRODEFINITION; 
y/AR 

stopch: char; 
lgth: integer; 

BEGIN 

if (rcount<0) or (rcount>maxmac ) then syntax( , # t ); 

if macroscrcount3.exec = nil then new ( macroscrcount3. exec ) ; 

stopch := exec^cj+id; 

lgth := scan(i-j»=stopch.exec*cj+2]) ; 

IF (LGTH = (I-J)) OR (LGTH > SIZEOF (COMARRAY ) ) OR (LGTH = 0) THEN 

BEGIN 

idR I TELINH OUTPUT, 'ERROR IN MACRO DEFINITIONS; 
EXIT(COMMAND) ; 
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ETJO (* D-FlfC MACRO *) ! 
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procedure: nowexecutemacro; 
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i«j: integer 
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macnum: integer; 
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error: boolean; 
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J := j +1; 
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save. exec := exec; 
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save. J := j; 
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IF EXEc~CJ3 = ESC THEN MACNUM := 1 
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else macnum := ordcexec^cjd-ordcom; 
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IF (MACROSCMACNUH3.EXEC = NIL) THEN 
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WRITELN ( OUTPUT, • ILLEGAL MACRO. . .TRY 
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end; 
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IF (MACNUM<0) OR (MACNUM > MAXMAC) THEN 
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EXEC := MACROSCMACNUM3.EXEC; 
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RCOUNT := RCOUNT -1; 
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BEGIN 
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COMMAND := TRUE; 
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EXIT(COMMAND) 
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ERROR := (J<I); 


982 


1 


20:3 


150 


IF ERROR THEN 
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RCOJ.NT := c,\ 

writeuh output, ♦ wacko halted* ) ; 
: r 0; 
end; 
exec := save. exec; 
1 := savE.i; 
J := savZ.j; 

IF ERROR THEN EXIT(COMMAND) J 
= ND (* Now EXECUTE ^ACKO *); 

PROCEDURE 0PTI0N-103; 

JLGI \) 

with option 00 

BEGIN 

OiOFF := NOT OMUFF; 
IF QNOFF THEN 

WITH SYSCOM*,CRTlNFO DO 
IF RCOJNT > 1 THEN 

LlSTSIZE := RCOUNT 

ELSE 

LlSTSIZE := HEIGHT 3IV 2 -1 

END 
END; 

PROCEDURE READFILE; 
\/AR 

lgth: integer; 

TITLE: STRINGC400; 
l<EGIN 

J := J +1; 

LGTH := SCAN(30,=EsC»EXEC /N CuJ) ; 
IF (LGTH <= 30) AND (LGTH > 0) THEN 
BEGIN 

TlTLECOIl := CHR(LGTH) ; 
M0\/ELEFT(EXEC A CJ3,TITLEC1D.LGTH) 5 
OPENOLOtlOFILE, TITLE) ; 
IF I0RE3ULT = Q THEN 

^EGIfj IF NEWFIN THEN EXIT ( COMMAND) END 
ELSl 
3EGIN 

OPEI\)OLD(lOFlLE,COrjCAT( TITLE, '.TEXT* )); 
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IF I3RF SU,_r = THE; J 

-jETGI'J IF" NEwFlN THEN EXIT ( COMMAND ) END 
El>C 

. E G I ''•■J 

'.4RirE.!_M(UUTPUTt »FIlE: ' , TITLE,' IS IN ERROR. MOT READ'); 

ex it (command) ! 
end; 

CNJ 
END 
ELSE 
BEGIN 

«v'RITELN( OUTPUT, 'FILE NAME ERROR. 1 ); 
EXIT (COMMAND) ; 
ENDS 
J := U +LGTH; 

end; 

procedure save; 

VAR 

POS, DELTA: INTEGER; 

BEGIN 

limeplacE(pos,rcounT) ; 

IF RCOuwT <= THEN 

DELTA := CURSOR -POS 
ELSE 

DELTA := POS -CURSOR; 
BUFEND ;= 3UFSIZE -DELTA; 
IF 3UFEND <= ENOPOS THEN 

BEGIN 

3ufend := 3ufsizl; 

writelni output, 'not enough room to save in'); 

exit (command) ; 

end; 

IF RCOj'-'T <= THEN 

MO VELEFT ( 8UF A C POS J »BUF~E BUFEND 1, DELTA) 
ELSE 

mon/elefkb'jf^c cur sor],buf' v c3ufendd, delta) 
end (* save *) ; 

procedure unsave! 

V'AR 
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STASHSlZE.ST/lSHEDATi JELTA: IfJTFSFR; 

if !;coj\ ; T = c the: si 

3JFt.;jj := SUF5IZE 

else: 

3EGI'j 

STASHSI2E := EiJDPOS -CURSOR; 
DELTA := BUFSI7E -BUFEND? 
STASHEDAT := CURSOR +DELTA; 

IF ((STASHE.DAT +STASHSIZE) < 3UFENQ) THEN 
3EGIU 

M0VERI3HT(bUF-CCURS0RJ,dUF-!ISTASHEDATJ,STASHSlZE); 

mqveleft (3uf*cbufend 3i 3 uf~c cursor d, delta ) ; 
engpos := eijdpos +delta; 
3uf"cendpos3 := chr(o) 

emo 

ELSE 

3EGIN WRITELN(0UTPUTt«N3T ENOUGH SPACE'); EXIT( COMMAND) END 
END (* * = *) 
END (* UNSAVE *) ; 

PROCEDURE VIEW; 
3 EG IN 

RCOUNT := o; LIST; 

RCOUNT ;= l; LIST 

END! 

PROCEDURE WRITEFILE; 
VAK 

LGTH: INTEGER; 

TITLE: STRINGC40J; 

BEGIN 

J := J +i; 

LGTH := SCAN(30i=ESCtEXEC*CjJ); 
IF (LGTH > 0) AND (LGTH <= 30) THEN BEGIN 
TITLEC03 := CHR(LGTH) ; 

M0\/ELEFT(EXEC"CJ],TITLEC1D,LGTH) ; 

IF (TITLECL6TH3 <> •.♦) AND (TITLECLGTHJ <> •]') AND 
(POS(». TEXT', TITLE) = 0) THEN 
TITLE := CONCATCTITLEi'.TEXT*); 
IF (TITLECLGTH] = ».•) THEN DELETE < TITLE, LGTH. 1 ) I 
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OPEN:jE/H iOriLui TITLE) ; 
IF lORESULT = THEN 

?JL'/.G'JTi_COrt 
ELSE ?EGZN 

/ji<ITEL,^(OUrPUr,CONCAT( 'FILE: '. TITLE* * IS IN ERROR. WRITE NOT DONE.' 

exit (command) ; 

end; 

END ELSE BEGIN 

WRIT1LN(0UTPJT, 'ILLEGAL TITLE* ) ; 

EXIT (COMMAND) ; 
END; 
J := J +LGTH; 

end; 

begin (*cqmmand*) 
command := false? 

NUMBER := C , 0*.. , 9' 3! 
J 1= 0; 

WHILE (J<I) DO 
BEGIN 

^HILE (EXECCJ] IN C* • tACR,CHR(TAB) iESCD) AND (J<I) DO 

J := SUCC(J) ; 
THisCH := EXECCJ3J 
NEG := (THISCH = •-') ; 
IF THISCH IN C , +'» , - , 3 THEN 
BEGIN 

j := j +i; 

thisch := execcju 

end; 
if (thisch in number) then 

3EGIN 

rcount := o; 

REPEAT 

RCOUNT := (RCOUNT*10) + ORDCEXECCJ^J-ORDCO* ) ; 

j := succ(J) 
until ((not (exec^cjd in number)) or (rcount > 3200)); 
thisch := exec^cj:; 
enu(* in number *) 
else rcount := 1! 

IF (THISCH IN c ,=, » , /»J) THEN 

IF (RCOUNT <> 1) THEN SYNTAX ( THISCH) 
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IF 

IF 
IF 



:lSl 

BEG 
I 

L. 

j 

T 

END 

NEG 

(J > 

(THI 

;ase 
1 71 

•A» 
•B» 
•C« 
•D» 
•E» 
•G» 
•H» 
•I' 
•J» 
•K» 
•L« 
•M» 
»N» 
•0' 
tpi 

»pt 
•Q» 



II J 

F (THISCH = •=•) THEN RCOUNT := 

LSE (* = •/• *) RCOUNT := 32700; 

:= u +1 ; 

HISCH := EXEC^CJD 



•EQUALLENGTH 



THEN 



THEN RCCUNT := -RCOUNT; 

= I) THEN EXIT(CQMMANO) ; 

SCH IN C *?'i »A«..'Z», , A , .. , Z»3) 

thisch of 

: prompts; 

:lineplace(Cursor, rcount) ; 

:cur50r:=o; <*da end*) 

:begin deletestuff; inserttext end; 

:deletestuff; 

:clearscreen? 

» 'f'.'g'cgetter; 

:writeln(0utput, • unimplemented ' ) ? 

: inserttext; 

: jumps 
:kill; 
:list; 

: ? jiacrodefinition; 
: nqwexecutemacro; 
: optionmod; 
, ♦ . * 7 1 



»S» 

•u» 
f w* 

»X» 



♦A 
♦8 

•c 

•0 
•E 
•F 
•H 
•I 
•J 
•K 
•L 
•H 
•N 
•0 
•T 
•T 

•a 



SYNTAX(THISCH) ; 



END 



BEGIN 

THISCH := EXEC A Cwi + lD; 
CLOSETHEWORLD(THISCH) 5 

COMMAND := (THISCH IN £ • E • 1 • E • , • U» , » U • 1 ) ; 
EXITCCOMMAND) 
END; 
•R'ireadfile; 
•s» :save; 
•u« :unsave; 

•v»:view 

•i*l»:WRlTEFlLE; 

•x»:begin kill; inserttext end 
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1139 i 216 542 LLiE SYIjTAX(THISCH) ; 

11*1 1 2:2 5s2 END (* .-JHILE J <= I *); 

11*2 1 2:i 334 IF OPTION. OrjOFT TUFF.' 

U93 1 2:* 561 --5 E G I J 

1194 i 2:3. o-zi CLEARSCREEN! 

11*5 1 2:3 5oH RCjLHT := -OPTION. L.ISTSIZE; 

113n i 2:3 57? LI 3T ; 

1197 1 2:3 574 WRITE ( OUTPUT. CHR< 10 (■* LF *))); 

119& I 2:3 562 RCOU'MT := OPT ION • LISTSI ZE \ 

1139 1 2:3 589 LIST 

1200 1 212 3d? EiJOi 

1201 1 2:3 591 fND (* COMMAND *); 

1202 1 2:j 618 

1203 1 i:c begin (*yalqe*) 

1204 1 i:i 3 INITIALIZE; 

1205 1 111 14 REPEAT 

1206 1 1:2 14 wRlTE(KEYBOARD. •*• ) ; (*CI_EARS A F AND ~S FLAGS!*) 

1207 1 1:2 22 {* THIS LIME IS FOR THE HAVAHEART COMMAND 

1203 1 1:2 22 * M0VELEFT(EXEC*i3UF*CENDP0S + i:ti 1 «IN<I»BUFEND-ENDP0S)>i 

1209 1 1:2 22 * WHICH SOME DAY MAY BE IMPLEMENTED *) 

1210 1 1:2 22 INCOMMAND 

1211 1 l:i 22 UNTIL COMMAND? 

1212 1 1:0 30 end; 

1213 1 1:0 50 

1214 1:0 BEGIN (* JUST A DUMMY *) 

1215 llO END. 
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(*SL 
(* SW 
(*SC 
(*ST+ 
<*SI 

<*$u- 

PROGR 



( **** 
(* 
( * 
( * 
( * 
(* 
( * 
{* 
( * 
< * 
(* 
( * 

( * 

( * 

(* 
( * 
(* 
( * 
( * 
( * 
{* 
(* 

( * 

( **** 

TYPE 
INFOR 



printer:*) 

APPING PASCAL COMPILER INCLUDE FILES *) 
COPYRIGHT (C) 1979 REGENTS UCSQ II. O.A.I*) 
*) (*$S+*) 

<?5:C0MPGLBLS.TEXT*) 
*) 

AM PASCALSYSTEM; (* VERSION II. 1-31-79 *) 

************** ****************************** j 

*) 

UCSD PASCAL COMPILER 



BASED ON ZURICH P2 PORTABLE 

COMPILER, EXTENSIVLY 

MODIFIED BY ROGER T. SUMNER 

SHAWN FANNING AND ALBERT A. HOFFMAN 

1976. .1979 

RELEASE LEVEL: 1.3 AUGUST, 1977 

I.«+ JANUARY, 1978 

1.5 SEPTEMBER, 1978 

II. JANUARY, 1979 

INSTITUTE FOR INFORMATION SYSTEMS 
UC SAN DIEGO, LA JOLLA, CA 92093 

KENNETH L. BOWLES, DIRECTOR 

COPYRIGHT (C) 1979, REGENTS OF THE 
UNIVERSITY OF CALIFORNIA, SAN DIEGO 



*) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 

*) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 



******************** + J([it . s)(!((!|[]((!t:!(cJ(t!((j)c!t:)Kj([))t!jc+!|( 
PHYLE = FILE; 

ec = record 

worksym, workcode: ~phyle; 
errsym,errblk,errnum: integer; 
SLOWTERM, stupid: boolean; 
altmode: char 
end; 
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SEGMENT PROCEDURE USERPROGRAM; 

SEGMENT PROCEDURE FlLEHANDLER 5 
BEGIN END? 

SEGMENT PROCEDURE DEBUGGER; 
BEGIN END; 

SEGMENT PROCEDURE pRlNTERROR; 
BEGIN END; 

SEGMENT PROCEDURE INITIALIZE? 
BEGIN END; 

SEGMENT PROCEDURE GETCMD! 
BEGIN END; 

SEGMENT PROCEDURE NOTUSEDi; 
BEGIN END; 

SEGMENT PROCEDURE N0TUSED2; 
BEGIN END? 

SEGMENT PROCEDURE N0TUSED3! 
BEGIN END; 

BEGIN END! (* USERPROGRAM *) 

SEGMENT PROCEDURE PASCALCOMPILER ( VAR USERINFO: INF0REC>! 

CONST DISPLIMIT = 12; MAXLEVEL = 8; MAXADDR = 28000; 
INTSIZE = l; REALSIZE = 2; BITSPERWD = 16; 
CHARSIZE = i; BOOLSIZE = l; PTRSIZE = 15 

FILESIZE = 300; NILFILESIZE = 40; 3ITSPERCHR = 85 CHRSPERWD = 25 
STRINGSIZE = 0; STRGLGTH = 2555 MAXINT = 32767; MAXDEC = 36; 
DEFSTRGLGTH = 80S LCAFTERMARKSTACK = 1; REFSPERBLK = 128; 
EO|_ = 13; MAXCURSOR = 1023; MAXCODE = 1299; 
MAxjTAB = 24; MAXSEG = 15; MAXPROCNUM = 1495 
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type 



(♦BASIC SYMBOLS, MUST MATCH ORDER In IDSEARCH*) 

SYM30L = (IDENTt COMMA, COLON, SEMICOLON, LPARENT , RPARENT , DOSY , TOSY . 

DOWNTOSY.ENOSY, UfJTlLSY , OFSY , THENSY , ELSESY , BECOMES, LBRACK, 
rno2 CK u ARR0W ' PERI0D,BEGIrgSY,IFSY » CAS ^SY,REPEATSY,WHlLESY, 
FORSY»WITHSY.SOTDSY,LABELSY,CONSTSY,TYPESY,VARSY,PROCSY, 
FUNCS Y. PROGS Y , FOR* ARDSY , INTCONST , REALCONST , STRINGCONST , 

NOTSY.MULOP,ADOOP,RELOP,SETSY,PACKEDSY,ARRAYSY,RECORDSY, 

FlLESY.OTHERSY,LONGCONST,USESSY,UNITSY,INTERSY,IMPLESY, 
EXTERNLSY.SEPARATSY); " ' 

OPERATOR = (MUL,RDIV,ANDOP, IOIV.IMOD, PLUS, MINUS, OROP,LTOP,LEOP, 
GEOp,GTOP,NEOP,EQOP,INOp,NOOP) ; 

SETOFSYS = SET OF SYMBOL; 

NONRESIDENT = ( SEEK, FREADREAL , FWRITEREAL,FREADDECFWRITEDEC .DECOPS) • 
NONRESPFLIST = ARRAYCNONRESIDENT] OF INTEGER; »OtCOPS) , 

CSTCLASS = (REEL. HSET»STRG,TRIX, LONG)! CONSTANTS*) 

CSP = ~ CONSTREC? 

CONSTREC = RECORD CASE CCLASS.* CSTCLASS OF 

long: (lleng.llast: integer; 

longval: arrayc1..93 of integer); 
trix: (cstval: array zl.qi of integer); 

(♦MUST COMPLETELY OVERLAP FOLLOWING FIELDS*) 

reel: (rval: read; 

pset: <pval: set of 0..127); 

strg: (slgth: c.strglgth; 

sval: packed ARRAY C1..STRGLGTH3 OF CHAR) 

end; 

valu = record case boolean of 

true: (ival: integer); 
false: (valp: csp) 

end; 

(*data structures*) 
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8ITRANSL = .0..3ITSPERWD; OPRANGE = Q..80; 
CURSRANGE = . .MAXCURSOR ; PROCRANGE = . .MAXPROCNUM ; 
LEVRANGE = O..^A.XLEVEL; ADORRANGE = 0..MAXADDR; 
JTA3RANGE = 0..MAXJTAB; SEGRANGE = 0..MAXSEG! 
DISPRANGE = 0..DIS'PLIMIT; 

STRUCTFORM = ( SCALAR , SUBRANGE ♦ POINTER tLONGIIMT » POWER , ARRAYS . 
RECORDS»FlLES»TAGFLDf VARIANT) ; 

DECLKIND = (STANDARD, DECLARED i SPECIAL ) J 

STP = * STRUCTURE? CTP = * IDENTIFIER? 
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STRUCTURE = 



RECORD 

size: addrr 
case form: 

SCALAR: 

subrange: 

pointer: 

power: 

ARRAYS: 



records: 
files: 
tagfld: 
variant: 

end; 



ange; 

structform of 
(CASE scalkind: DECLKIND OF 
declared: (fconst: ctp>); 
(rangetype: stp; min.max: valu); 
(eltype: stp); 
(elset: stp); 
(aeltype.inxtype: stp; 
case aispackd:boolean OF 
true: (elsperwdtelwidth: bitrange; 
case aisstrng: boolean of 
true:(maxleng: l.strglgth) )) ; 
(fstfld: ctpj recvar: stp>; 
(filtype: stp); 

(Tagfieldp: ctp; fstvar: STP); 
(nxtvar»subvar: stp; varval: valu) 



IDCLASS = (TYPES««ONST,FORMALVARS»ACTUALVARS, FIELD. 

PROC.FUNCtMODULE) J 
SETOFIUS = SET OF IDCLASS; 
IDKIND = (ACTUALtFORMAL) 5 
ALPHA = PACKED ARRAY C1..83 OF CHAR; 

IDENTIFIER = RECORD 

name: alpha; llink, rlink: ctp; 



(♦NAMES*) 
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idtype: stp; next: ctp; 

CASE KLASS; IDCLASS OF 

konst: (values: valid ; 



FORMALVARS» 
ACTUALVARS: 



field: 



PROC, 

func: 



MODULE: 

end; 



(vlev: levrange; 

vaddr: addrrange; 

case boolean of 

true: (public: boolean)); 
(fldador: addrrange; 

case fispackd: boolean of 

TRUE: (FLDRBIT.FLDWIDTH: BITRANGE)); 

(case pfdeckind: declkind of 
special: (key: integer); 
standard: (cspnum: integer)} 
declared: (pflev: levrange; 

pfname: PROCRANGE! 
pfseg: segrange; 
case pfkind: idkind of 
actual: (locallc: addrrange; 
forwdecl: boolean; 
exturnal: boolean; 
inscope: boolean; 
case boolean OF 
Tlum true: <imported:boolean))>>{ 

INTEGER) 



(Segid: 



WHERE = (BLCK,CREC,VREC,REC); 

ATTrkIND = (CST,VARBLtEXPR); 

VACCESS = (DRCT,INDRCT,PACKO,MULTItBYTEI| 



(♦EXPRESSIONS*) 



attr = record typtr: stp; 

case kind: attrkind of 
cst: (cval: valu); 
varbl: (case access: vaccess of 

drct: (vlevel: levrange; dplmt: 
indrct: (idplmt: addrrange)) 



ADDRRANGE) ; 
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END; 

testp = ~ testpointer; 
te3tp0iuter = record 

ELT1,ELT2 
LASTTESTP 
END! 



stp; 

TESTP 



(♦LABELS*) 

lbp = ~ codelabel; 

CODelABEL = RECORD 

case defined: boolean of 
false: (reflist: addrrange); 
true: (occuric: addrrange; jtabinx: jtabrange) 

END; 

la3elp = * userlabel; 
userlabel = record 

labval: integer; 

nextlab: labelp; 

codelbp: lbp 

END; 

REFARRAY = ARRAYC 1 . .REFSPERBLK3 OF 
RECORD 

keytoffset: integer 

end; 

codearray = packed array c0..maxcodej of char; 
sym3ufarray = packed array ccursrange3 of char; 

unitfile = (workcode.sysli3rary); 

lexstkrec = record 

doldtop: disprange; 
doldlev: o..maxlevel} 
poldproc.soldproc: procrange; 
doldseg: segrange; 
dllc: addrrange; 
3fsy: symbol; 
dfprocp: ctp; 
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OMArtKP: "INTEGER 5 

issegment: boolean; 
prevlexstackp: ^lexstkrec 

END; 



codep: * codearray; 
SYMauFP: A symbufakray; 

gattr: attr; 
top: disprange; 

LCtlC: ADDRRANGE; 

test; boolean; 
intptr: stp; 
seg: segrange; 



symcursor: cursrange; 
sy: symbol; 
op: operator; 
id: alpha; 

lgth: integer; 



val: valu; 
disx: disprange; 

LCMAx: ADDRRANGE; 



*) 



(*C0DE BUFFER UNTIL WRITEOUT*) 
(♦SYMBOLIC BUFFER. ..ASCII OR CODED*} 

(♦DESCRIBES CURRENT EXPRESSION*) 

(♦TOP OF DISPLAY*) 

{♦LOCATION ANO INSTRUCT COUNTERS*) 

(♦POINTER TO STANDARD INTEGER TYPE^) 
(♦CURRENT SEGMENT NO,*) 
(♦SCANNER GLOBALS...NEXT FOUR VARS*) 
(♦MUST BE IN THIS ORDER FOR IDSEARCH^) 
(♦CURRENT SCANNING INDEX IN SYMBUFP"*) 
(♦SYMBOL FOUND BY INSYMBOL+) 
(♦CLASSIFICATION OF LAST SYMBOL^) 
(♦LAST IDENTIFIER FOUNDS) 

(♦LENGTH OF LAST STRING CONSTANT IN CHARS 
OR LEN OF LAST LONG INTEGER CONSTANT 
IN DIGITS*) 
(♦VALUE OF LAST CONSTANT^) 
(♦LEVEL OF LAST ID SEARCHED^) 

{♦TEMPORARIES LOCATION COUNTERS) 

(♦SWITCHES:^) 



prterr,gotook,rangecheck» debugging* 
noisy,codeinseg,iocheck,bptonline, 
clinkerinfcdlinkerinfo, list, tiny ,lsepproc, 

op, including, us i NGtNoswAP»SEPpRoc, 
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STAKTlNGUP.INMODULLtlNINTERFACEiFLIPBYTESt 
LIBNQTOPENiSYSCOMPiPUBLlCPROCSiGETSTMTLEV: BOOLEAN) 
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<*INTPTRt*)REALPTRiLONGINTPTRf 
CHARpTRtBOOLPTR, 

textptr»nilptr» 
Iimtractvptr,strgptk: stp; 

UTYPPTRiUCSTPTR,uVARPTRi 

ufldptr»uprcptr,ufctptr» 
modptr.inputptr.outputptr, 
outerblock,fwptr,usinglist: CTP; 

globtestp: TESTP; 

level: LEVRANGE; 
BEGSTMTLEV.STMTLEV: INTEGER? 
MARKp; ^INTEGER; 

tos: ~lexstkrec; 
glev: disprange? 
newblock: boolean; 

nextseg: segrange; 
seginx: integer; 
sconst: csp; 
strgcstic: aodrrange; 



(♦pointers:*) 

(♦pointers TO STANDARD IDS*) 
(♦POINTERS TO UNDECLARED IDS*) 

(♦LAST TESTPOINTER*) 

(♦CURRENT STATIC LEVEL*) 

(♦CURRENT STATEMENT NESTING LEVEL*) 

(♦FOR MARKING HEAP*) 

(♦TOP OF LEX STACK*) 

(♦GLOBAL LEVEL OF DISPLAY^) 

(♦INDICATES NEED TO PUSH LEX STACKS) 

(♦NEXT SEGMENT #*) 
(♦CURRENT INDEX IN SEGMENT^) 
(♦INSYMBOL STRING RESULTS^) 
(♦ADDR OF LAST STRING IN CODE^) 



lowtlmetlineinfo,screendots*startdots.symblk,smallestspace: integer; 
linestart: cursrange; 



CURPROCtNEXTPROC: PROCRANGE; 



(♦PROCEDURE NUMBER ASSIGNMENT^) 



constsegsystsimptypebegsys»typebegsys. 

blockbegsys»selectsys,facbegsys,statbegsysitypedels: setofsys; 
vars: setofids; 

display: array cdispranged of 

RECORD 

fname: ctp; 

case occur: where of 
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blck: (ffile: ctp; flabel: labelp); 

crec: (clev: levrange; cdspl: addrrange); 

vrec: (vospl: addrrangE) 

end ; 

PFMUvjoF: NONRESPFLXST; 

proctable: ARRAY cprocrangeh OF integer; 

segtable: array csegrange: of 
record 

DlSKADDRtCODELENG: INTEGER; 

SEGNAME: ALPHA; 

SEGKIND, 

textaddr: integer 
end (*segtable*) 5 

comment: ^string; 

SYSTEMLIB: STRINGC40D; 
NEXTJTAB: JTABRANGE! 

jta3: array cjtabranged of integer; 

Reffile: file; 
nrefstrefblk: integer; 
reflist: ^refarray; 
oldsymblktprevsymblk: integer; 

oldsymcursor,oldlinestart,prevsymcursor,prevlinestart: cursrange; 
usefile: unitfile; 

INCLFILEiLIBRARY: FILE; 
LP: TEXT; 

CURBYTE, CURBLK: INTEGER! 

diskbuf: packed array C0..5113 of char; 



(*• 



*) 

1 99 (* FORWARD DECLARED PROCEDURES NEEDED BY COMPINIT *) 

1 PROCEDURE ERROR(ERRORNUM: INTEGER); 

FORWARD; 
1 PROCEDURE GETNEXTPAGE? 



335 



336 



369 


10 


3:3 


370 


10 


4:d 


371 


10 


4:d 


372 


10 


5:d 


373 


10 


5:0 


374 


10 


6:d 


375 


10 


6ID 


376 


10 


6:o 


377 


10 


&:d 


378 


10 


6:d 


379 


10 


7:d 


380 


10 


7;d 


381 


10 


s:d 


382 


10 


8:d 


383 


10 


9:d 


381 


10 


9:d 


385 


10 


io:d 


386 


10 


io:d 


387 


10 


h:d 


388 


10 


n:o 


389 


10 


12:d 


390 


10 


12:0 


391 


10 


13 :d 


392 


10 


i3:d 
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getbounds(fsp: stp; var fmin»fmax: integer); 
skip(fsys: setofsys); 



1 FORWARD; 

1 PROCEDURE PRINTLINE; 

1 FORWARD; 

1 PROCEDURE ENTERID(FCP: CTP); 

2 FORWARD; 

1 PROCEDURE INSYMBOL; 

1 FORWARD; 

1 

1 (* FORWARD DECLARED PROCEDURES USED IN BOTH DECLARATIONPART AND BODYPART *) 

1 

1 PROCEDURE SEARCHSECTlON(FCP:CTP; VAR FCPi: CTP); 

3 FORWARD 
1 PROCEDURE SEARCHID(FIDCLS: SETOFIDS; VAR FCP: CTP); 

3 FORWARO 
1 PROCEDURE 

4 FORWARD 
1 PROCEDURE 

5 FORWARD 

3 FUNCTION pAOFCHAR(FSp: STP): BOOLEAN; 

4 FORWARD 

3 FUNCTION STRGTYPE(FSp: STP): BOOLEAN! 

4 FORWARD 

3 FUNCTION DECSIZEti: INTEGER): INTEGER; 

4 FORWARD 
1 PROCEDURE 
7 FORWARD 
3 FUNCTION cOMPTYPES(FSPl»FSP2: STP): BOOLEAN; 

5 FORWARD 

1 PROCEDURE 

2 FORWARD 

1 PROCEDURE 

2 FORWARD 
1 PROCEDURE 
1 FORWARO 

1 PROCEDURE 

2 FORWARD 
1 PROCEDURE 
5 FORWARD 
5 

5 (*$I 85:C0MPGLBLS.TEXT*) 
5 (*$I H5:C0MPINIT.TEXT*> 



CONSTANT(FSYS: SETOFSYS; VAR FSP: STP! VAR FVALU: VALU); 



genbyte(Fbyte: integer); 
genword(FwoRD: integer); 
writetext; 

writecodhfoRcebuf: boolean); 
blocmfsys: setofsys); 
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1 SEGMENT PROCEDURE COMPINIT! 

PROCEDURE ENTSTDTYPES; 
BEGIN 

NEW ( I NTPTR, SCALAR* STANDARD) ; 
WITH INTPTR* DO 

BEGIN SIZE := INTSIZE; FORM := SCALAR; SCALKIND := STANDARD END; 
NEW(REALPTR,SCALAR'STANDARD) 5 
WITH REALPTR* DO 

BEGIN SIZE := REALSIZE; FORM := SCALAR; SCALKIND := STANDARD END; 
NEW(LONGINTPTRiLONGlNT) ; 
WITH LONGINTPTR A DO 

BEGIN SIZE := DECSIZE((BITSPERWD-1)*100 DIV 332 + 1)5 FORM := LONGINT END; 
NEW(CHARPTR,SCALAR»STANDARD); ' 

WITH CHARPTR* DO 

BEGIN SIZE := CHARSIZE; FORM := SCALAR; SCALKIND := STANDARD END; 
NEW (300LPTR, SCALAR t DECLARED); 
WITH BOOLPTR* DO 

BEGIN SIZE :=-B00LSIZE5 FORM := SCALAR; SCALKIND := DECLARED END; 
NEWCMILPTR, POINTER) ? 
WITH NILPTR A DO 

BEGIN SIZE := PTRSIZE; FORM := POINTER; ELTYPE := NIL END; 
NEW(TEXTPTR.FILES)? 
WITH TEXTPTR* DO 

MrSP 1 ^"!? I = ' rILESlZE:+ CHARSIZE; FORM :* FILES; FILTYPE := CHARPTR END; 

new(intractvptr,files) ; 
with intractvptr* do 

BEGIN SIZE 1= FILESIZE+CHARSIZE; FORM := FILES; FILTYPE := CHARPTR END; 
NEW (STRGPTR, ARRAYS* TRUE, TRUE); 
WITH STRGPTR* DO 

BEGIN FORM := ARRAYS; SIZE := (DEFSTRGLGTH + CHRSPERWD) DIV CHRSPERWD; 
AISPACKD := TRUE; AlSSTRNG := TRUE? INXTYPE := INTPTR; 
ELWIDTH := BITSPERCHR; ELSPERWD := CHRSPERWD; 
AELTYPE := CHARPTR; MAXLENG := DEFSTRGLGTH; 
END 
END (*ENTSTDTYPES*) 5 

PROCEDURE ENTSTDNAMES; 

VAR CP.CPi: CTP; i: INTEGER; 
BEGIN 
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00 
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= 'REAL 



= »CHAR 



NEW (CPi TYPES) 

with cp~ do 

begin name 
enterio(cp) ! 
new(cp'types) 
with cp" do 

begin name 
enterid(cp) j 
new(cp'types) 
with cp~ do 

begin name 
enterid(cp) ; 
new(cp'types) 
with cp* do 

begin name 
enterid(cp); 
new(cp«types) 
with cp a do 

begin name 
enterid(cp); 
new<cp»types) 
with cp" do 

begin name 
enterid(cp) ; 
new(cp'types) 
with cp* do 

begin name 
enterid(cp)! 

new( inputptr*formalvars,fa 
with inputptr* do 

begin name := »input • 
vlev := 0; vaddr := 2 

end; 

ENTERID(INPUTPTR) i 
NEW(OUTPUTPTR«FORMALVARS*F 
WITH OUTPUTPTR* DO 

BEGIN NAME := 'OUTPUT ' 
VLEV := 0; VADDR := 3 

END: 
ENTERID(OUTPUTPTR) ? 
NEW(CP»FORMALVARStFALSE) ; 



= 'INTEGER •! IDTYPE := INTPTR; KLASS := TYPES END; 



♦; idtype := realptr; klass := types end; 



idtype := charptr; klass := types end; 



= 'BOOLEAN »; idtype := boolptr; klass := types end; 



= 'string »; idtype := strgptr? klass := types end; 



= 'TEXT 



'? IDTYPE := TEXTPTR5 KLASS := TYPES END! 



= 'INTERACT'! IDTYPE 
LSE) ; 
; IDTYPE 

ALSE); 
; IDTYPE 



:= INTRACTVPTR; KLASS := TYPES END; 



;= textptr; klass := forwalvarS; 



1= textptr; klass := formalvars; 
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WITH CP" DO 

BEGIN NAME := 'KEYBOARD'; IDTYPE := TEXTPTR.; KLASS := FORNiALVARS; 
vlev := 0; VADOR := 4 

ENq; 

enterid(cp) ! 
cpi := nil; 

FOR I := TO 1 DO 
BEGIN NEW(CPtKONST) ; 
WITH CP~ DO 

BEGIN IDTYPE := BOOLPTR; 

IF I = THEN NAME := 'FALSE • 
ELSE NAME := 'TRUE ♦? 

NEXT := CPU VALUES. IVAL := I; KLASS := KONST 
END; 

enterid(cp); cpi := cp 

END; 
BOOLPTR*. FCONST •= CP; 
NEW(CP'KONST) ; 
WITH CP* DO 

BEGIN NAME := »NIL ♦! IDTYPE := NILPTR; 

NEXT := NIL; VALUES. IVAL := 0» KLASS := KONST 

END; 
ENTERID(CP); 
NEW(CP»KONST) ; 
WITH CP* DO 

BEGIN 

name := 'maxint »{ idtype := intptr; 
klass := konst; values. ival := maxint 

END; 

enterid(cp) ; 
end (*entstdnames*) ; 

procedure entundecl5 
begin 
new(utypptr»types)5 

WITH UTYPPTR* Do 

BEGIN NAME := ' 
NEW(UCSTPTR, KONST) ! 
WITH UCSTPTR* DO 

BEGIN NAME := • 



•; IDTYPE := NIL; KLASS := TYPES end; 



VALUES. IVAL := 0; KLASS := KONST 



'; idtype := nil; next := nil; 
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4: 

4; 

4! 

4: 
4; 
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74 

76 
81 
85 
04 
22 
24 
29 
33 
57 
65 
67 
72 
76 
00 
20 
35 
48 
50 
55 
59 
83 
03 
18 
31 
33 
46 
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60 
20 
80 
40 
00 
60 
20 
80 



END; 
NEW(UVARPTR.ACTUALVARStFALSE) ; 

WITH UVARPTR'* DO 

RFr T M AiAME := » ' ! iutype := nil; 

NEXT := NIL! VLEV := 0; VADDR *•= 01 KLASS := ACTUALVARS 

END; 
NEW(UFLDPTRiFIELD) » 

FLOADDR := 0; KLASS := FIELD 

END * 
NEW (JPRCPTR.PROC, DECLARED, ACTUAL i FALSE); 

"Teg^ST:- •« IDTYPE : = NIL. FORWDECL := FALSE; 

NEXT •= NILI INSCOPE : = FALSE; LOCALLC := 0; EXTURNAL := FALSE; 

pflev := 0; pfname := 0; pfseg := o; .„-,,«, 

klass := proc; pfdeckind := declared? pfkind := actual 

NEW (UFCTPTRiFUNC, DECLARED, ACTUAL, FALSE); 
WI RrrTN C NAMr--°. ■« IDTYPE := NIL; NEXT «.= NIL; 

BEG F orwdecl 'si false; exturnal* := false; inscope := false; locallc :« 0; 
pflev := 0; pfname := o; pfseg := o; 
klass := func; pfdeckind := declared; pfkind := actual 

END 
END (*ENTUNDECL*) 5 



PROCEDURE ENTSPCPROCS 
LABEL 1! 

var lcp: 



BEGIN 
NAC 
NAC 
NAC 



na: 

13 

4: 
73 
NAC103 
NAC133 
NAC163 
NAC193 
NAC223 
NAC253 



ctp; 1: integer; isfunc: boolean; 

ARRAY Cl„«] OF ALPHA; 



•READ ' 
•WRITELN • 
•PRED ' 
•SQR * 
♦UNITREAD* 

•LENGTH ' 
♦COPY ' 
•MOVERIGH* 
•TREESEAR» 



NAC 23 := 'READLN 



NAC 53 
NAC 83 
NAC113 
NAC143 
NAC173 
NAC203 
NAC233 



•EOF 

•SUCC 

•ABS 

♦UNITWRIT 

•INSERT 

•POS 

•EXIT 



NAC263 := 'TIME 



NAC 33 
NAC 63 
NAC 93 
NAC123 
NAC153 
NAC183 
NAC213 
NAC243 
NAC273 



•WRITE 

•EOLN 

»ORD 

»NEW 

•CONCAT 

'DELETE 

•MOVELEFT 

♦IDSEARCH 

•FILLCHAR 
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40 


NAC233 := 'OPENNEW •; NAC293 


:= 'OPENOLD • 5 NAC 30 3 := 'REWRITE '! 


574 


11 


5:i 


00 


NAC31D := 'CLOSE •; NAC323 := 'SEEK •? NAC333 := 'RESET •; 
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5:i 


60 


NAC34H := 'GET •; NAC353 := 'PUT •; NAC363 := 'SCAN •; 
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11 


5:i 


20 


NAC37D := 'BLOCKREA'; NAC383 := 'BLOCKWRI'S NAC393 := 'TRUNC '; 


577 


11 
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80 


NAC40] := 'PAGE •; NAC413 := 'SIZEOF • ; NAC423 := 'STR '; 


578 
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40 


NAC43D := »GOTOXY • 5 
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FOR 1 := 1 TO 43 00 
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BEGIN 




581 
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74 


IF TINY THEN 




582 


11 


5:4 


78 


IF I IN C2»7,8«1Q,13,17,18,19,20»32,34, 


35,40,42,433 THEN 


583 
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92 


GOTO 1; 
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94 


ISFUNC := I IN C5, 6, 7, 8, 9, 10, 11, 15, 16, 19, 20 


,25,36,37,38,39,43 
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08 


IF ISFUNC THEN NEW <LCP,FUNC , SPECIAL ) 
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16 


ELSE NEW(LCP,PROCfSPEClAL) ; 
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23 


WITH LCP A DO 




588 
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5:4 


27 


BEGIN NAME := NACI3; NEXT := NIL? IDTYPE 


:= nil; 
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53 


IF ISFUNC THEN KLASS := FUNC ELSE KLASS 


:= proc; 
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72 


PFDECKIND != SPECIAL; KEY := I 
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84 


end; 
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86 


ENTERID(LCP) ; 
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I.' END 
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END (*ENTSPCPROCS*) ; 
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PROCEDURE ENTSTDPROCS; 
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VAR LCPtPARAM: CTP? LSP.FTYPE: STP! I: INTEGER? 


isproc: boolean; 
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NA: ARRAY Cl.,193 OF ALPHA; 
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BEGIN 
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NAC 13 := »ODD »; NAC 23 ' 


;= 'CHR •; NAC 


33 := 'MEMAVAIL'; 
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60 


NAC 43 := 'ROUND '; NAC 53 , 


:= 'SIN •; nac 


63 := 'COS •; 


602 


11 
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20 


NAC 73 := 'LOG •; NAC 83 ; 


:= 'atan *; nac 


93 := »LN '{ 
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6:1 


80 


NAC103 != 'EXP '; NAC113 


!= 'SORT •; NAC123 := 'MARK •; 
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40 


NAC133 := 'RELEASE '; NAC143 


:= 'IORESULT'; NAC153 := 'UNITBUSY'J 


605 


11 
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00 


NAC163 := 'PWROFTEN'; NAC173 . 


1= 'UNITWAIT'5 NAC183 := 'UNITCLEA'5 
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NAC193 := 'HALT ♦; 
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80 


FOR I := 1 TO 19 DO 
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BEGIN ISPROC := I IN C 12 , 13, 17. 18, 193? 




609 


11 


6:3 


04 


CASE I OF 
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l: BEGIN FTYPE := BOOLPTR; NEWtPARAM, ACTUALVARS, FALSE ) ; 


611 


11 


6:5 


16 


WITH PARAM" DO 
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6:6 


19 


BEGIN IDTYPE 1= INTPTR; KLASS := i 


^CTUALVARS END 


613 


11 


6:4 


31 


end; 
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2: FTYPE := charptr; 

3: BEGIN FTYPE := INTPTR; PARAM := NIL END; 

4: BEGIN FTYPE : = INTPTR; NEW ( PARAM. ACTUALVARS, FALSE ) ; 

WITH PARAM" DO 3EGIN IDTYPE := REALPTR; KLASS := ACTUALVARS END 

end; 
5: ftype := realptr; 

12: BEGIN FTYPE := NILS NEW (PARAM, FORMALVARS, FALSE ) 5 NEW (LSP, POINTER ) : 
WITH LSP" DO 

BEGIN SIZE := PTRSIZEJ FORM := POINTER; ELTYPE := NIL END? 
WITH PARAM" DO BEGIN IDTYPE := LSP5 KLASS := FORMALVARS END 

end; 

14: BEGIN FTYPE := INTPTR; PARAM := NIL END; 
15: BEGIN FTYPE := BOOLPTR; NEW (PARAM. ACTUALVARS, FALSE) ; 
WITH PARAM" DO 

BEGIN IDTYPE := INTPTR; KLASS := ACTUALVARS END; 
END! 

16: ftype := realptr; 
17: ftype := nil* 

19: BEGIN FTYPE := NIL; PARAM := NIL END 
END (*PARAM ANO TYPE CASES*) I 
IF ISPROC THEN NEW (LCP.PROC .STANDARD ) 
ELSE NEW(LCP,FUNC, STANDARD); 
WITH LCP" DO 

BEGIN NAME := NACI3; PFDECKJND := STANDARD; CSPNUM :* I ♦ 20? 
IF ISPROC THEN KLASS := PROC ELSE KLASS := FUNC; 
IF PARAM <> NIL THEN PARAM". NEXT := NIL; 
IDTYPE := FTYPE; NEXT := PARAM 
ENDI 
ENTERID(LCP) 
END 
END (*ENTSTDPROCS*) » 

PROCEDURE INITSCALARS; 

VAR I* NONRESIDENT! 
BEGIN 

IF MEMAVAIL > 9950 (* EMPIRICAL VALUE FOR A 50K BYTE MACHINE *) THEN 

noswap := true else noswap := false? 
fwptr := nil; modptr := nil; globtestp := nil; 

LINESTART := 0; LINEINFO := LCAFTERMARKSTACK ; LIST := FALSE; 
SYMBLK := 2; SCREENDOTS := 0; STARTDOTS := 0; 
FOR SEG := TO MAXSEG DO 
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WITH SEGTABLECSEGJ DO 

3EGIN DISKADDR := 0; CODELENG := 05 SEGNAME ;= • ♦; 

SEGKIND := 0! TEXTADDR := 
END; 
USINGLIST := NIL; 
IF USERINFO. STUPID THEN SYSTEMLIB := »*SYSTEM. PASCAL* 

else systemlib := • *system. library' ; 

lc := lcaftermarkstack; iocheck := true; dp := true; 

seginx := 0; nextutab := 15 nextproc := 2; curproc := ll 

new(sconst); new(symbufp) ; new(codep); 

clinkerinfo != false; dlinkerinfo := false? 

seg := 1; nextseg := 10; curblk := i; curbyte := o? lsepproc := false; 

STARTINGUP := TRUE? NOISY := NOT USERINFO, SLOWTERM? SEPPROC := FALSE; 
DEBUGGING := FALSE; BPTONLINE := FALSE; INMODULE := FALSE; 
GOTOOK := FALSE; RANGECHECK := TRUE; SYSCOMP := FALSE; TINY := FALSE? 
CODEINSEG := FALSE? PRTERR := TRUE? INCLUDING := FALSE? USING := FALSE? 
FOR I := SEEK TO DECOPS DO PFNUMOFCI3 := 0? 
COMMENT := NIL? LlBNOTOPEN := TRUE? 
GETSTMTLEV := TRUE? BEGSTMTLEV := 0? 
FLIP9YTES := FALSE 
END (*INITSCALARS*) ? 

PROCEDURE INITSETS; 
BEGIN 

constbegsys := CADD0P,INTC0NST,REALC0NST,STRINGC0NST,IDENT3? 

simptypebegsys ;= CLPARENT3 + constbegsys? 

typebegsys := CARROW,PACKEDSYiARRAYSY»RECORDSYiSETSY«FILESYD 
+ SIMPTYPEBEGSYS? 

TYPEDELS := CARRAYSY»RECORDSY,SETSYtFILESY3? 

BLOCKBEGSYS := CUSESSY.LABELSY* CONSTSYtTYPESYi VARSY, 

PROCSYiFUNCSY,PROGSY,BEGINSY3? 

SELECTSYS := C ARROW ,PERIOD»LBRACKD? 

FACBEGSYS := C lNTCONST»REALCONST,LONGCONST. STRINGCONST, IDENT. 
LPARENT»LBRACK,NOTSY3? 

STAT3EGSYS := CBEGlNSYtGOTOSY, IFSY» WHILESYtREPEATSY,FORSY, WITHSY.CASESYD? 

VARS := CFORMALVARS,ACTUALVARS3 
END (*INITSETS*) ? 

BEGIN <*COMPINIT*> 

INITSCALARS; INITSETS; 

level := 0; TOP := 0? 
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IF NOISY THEN 
BEGIN 

FOR IC := 1 TO 7 DO WR ITELN ( OUTPUT ) ; 
*|RITELN(0UTPUT, 'PASCAL COMPILER C II.0.A.13* ) ; 
WRlTEtOUTPUT. •< 0>M 

end; 
with displaycod do 

BEGIN FNAME := NIL; FFILE := NIL; FLABEL := NIL; OCCUR := BLCK END; 

smallestspace:=memavail; 
getnextpage5 

INSYM30L; 

entstdtypes; entstdnames; entundecl; 
entspcprocs; entstdprocs; 
if syscomp then 
begin outerblock := nil? seg := 0; nextseg j= 1? 
glev :=l; blockbegsys ;= 3l0ckbegsys + cunitsy.separatsy3 

END 
ELSE 

BEGIN TOP := l; LEVEL := 15 
WITH DISPLAYC13 DO 

BEGIN FNAME := NIL; FFILE != NIL; 

FLABEL := NIL? OCCUR := BLCK 
END; 
LC := LC+2; GLEV := 3; (*KEEP STACK STRAIGHT FOR NOW*) 
NEW { OUTERBLOCK, PROC, DECLARED* ACTUAL. FALSE)} 
WITH OUTERBLOCK* DO 

BEGIN NEXT : = NIL; LOCALLC := LC; 

NAME := 'PROGRAM '; IDTYPE := NIL; KLASS := PROC I 

PFDECKIND •= DECLARED; PFLEV 1= 0! PFNAME := l; PFSEG := SEG; 

pfkind := actual; forwdecl := false; exturnal := false; 
inscope := true 

END 

end; 
if sy = progsy then 
begin insymbol; 
if st = ident then 
begin segtablecseg3.segname ;= id; 
if outerblock <> nil then 

8EGIN 

OUTERBLOCK*. NAME := ID; 

ENTERID(OUTERBLOCK) UALLOWS EXIT ON PROGRAM NAME*) 






737 11 lie 4 3 END 

738 11 i:<4 46 £|\|D 

739 11 i:3 46 ELSE ERR0R(2); INSYMBOL; 

740 11 1:3 55 IF SY = LPARENT THEN 

741 11 1:4 60 3EGIN 

742 11 1:5 60 REPEAT INSYMBOL 

7^3 11 1:5 60 UNTIL SY IN ERPARENT t SEMICOLOND+BLOCKBEGSYS ; 

744 11 1:5 75 IF SY = RPaRENT THEN INSYMBOL ELSE ERR0R(4) 

745 11 1:4 86 £ND; 

746 11 1:3 89 IF SY = SEMICOLON THEN INSYMBOL ELSE ERR0RU4) 

747 11 1:2 00 END? 

748 11 111 03 MARK(MARKP); 

749 11 i:i 07 NEW(T0S)5 

750 11 i:i 12 WITH T0S A DO (*MAKE LEXSTKREC FOR OUTERBLOCK*) 

751 11 1:2 16 BEGIN 

752 11 1:3 16 PREVLEXSTACKP:=NlLi 

753 11 1:3 21 bfsy:=period; 

754 11 1:3 26 DFpR0CP:=0UTERBL0CK5 

755 11 1:3 32 DLLC:=LCi 

756 11 1:3 37 DOLDLEV:=LEVEL< 

757 11 1:3 43 DOlDTOP:=TOP! 

758 11 i:3 46 POLDPROC:=CURPROCl 

759 11 1:3 52 ISSEGMENT:=FALSE? 

760 11 1:3 57 DMARKPlsMARKP; 

761 11 1:2 63 END? 

762 11 l:o 63 END UCOMPINIT*) 5 

763 11 1:0 80 <*SI 85:C0MPINIT.TEXT*> 

763 11 i:o 80 (*$I 85:DECPART.A.TEXT*) 

764 11 i:o 80 

765 11 i:o 80 (* COPYRIGHT (C) 1979, REGENTS OF THE *) 

766 11 1:0 80 (* UNIVERSITY OF CALIFORNIA, SAN DIEGO *) 

767 11 1:0 80 

768 12 i:D 1 SEGMENT PROCEDURE DECLARATlONPART(FSYS: SETOFSYSM 

769 12 i:D 5 VAR LSY: SYMBOL! 

770 12 i:D 6 NOTDONE: BOOLEAN; 

771 12 i:D 7 DUMMYVAR: ARRAYC0..03 OF INTEGER; (*FOR PRETTY DISPLAY OF STACK AND HEAP *) 

772 12 i:D 8 

773 12 2td 1 procedure typcfsys: setofsys; var fspi stp? var fsize: addrrangem 

774 12 2!d 7 var lsp.lsp1 ,lsp2: stp; oldtop: disprange; lcp: ctp; 

775 12 2:d 12 lsize,displ: addrrange; lmin,lmax: integer; 

776 12 2id 16 packing: boolean; next3it,numbits: bitrange; 
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var fsp:stp; var 
ttop: disprangE; 



THEN 
SIMPTYPEBEGSYS) 



END! 



:= intsize; 
:= declared 

LCNT := 0; 



FORM := SCALAR; 



procedure simpletype(fsys:set0fsys5 
var lsp.lspi: stp; lcpilcpjl: ctp; 
lcnt: integer; lvalu: valu; 
begin fsize := 1; 
if not (sy in simptypebegsys) 
3egin error(l); skip(fsys + 
if sy in simptypebegsys then 

3EGIN 

IF SY = LPARENT THEN 
BEGIN TTOP := TOP; 

WHILE DISPLAYCTOP3. OCCUR <> BLCK DO TOP := TOP - 1 
NEW(LSPtSCALAR.DECLARED) ; 
WITH LSP" DO 
BEGIN SIZE 
SCALKIND 
END; 

lcpi := nil; 

REPEAT INSYMBOL; 

IF SY = IDENT THEN 

BEGIN NEW(LCPtKONST)! 
WITH LCP* DO 

BEGIN NAME := ID; IDTYPE := LSP; NEXT 
VALUES. IVAL := LCNT» KLASS ;= KONST 
END; 
ENTERID(LCP); 
LCNT := LCNT + 11 
LCP1 := LCP5 INSYMBOL 
END 
ELSE ERR0R(2) 5 

IF NOT (SY IN FSYS + CCOMMA,RPARENT]) THEN 
BEGIN ERR0R(6); SKIP1FSYS + C COMMA, RPARENTD) 
UNTIL SY <> COMMA; 
LSP^.FCONST := LCPl; 
IF SY = RPARENT THEN 
END 
ELSE 
BEGIN 

IF SY = IDENT THEN 

BEGIN SEARCHIDCCTYPES.KONSTD.LCP) ; 
INSYMBOL! 



fsize:addrrange) 



:= lcpi; 



END 



top := ttop; 
insymbol else 



ERRORU) 
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IF LCP*.KLASS = KONST THEN 
BEGIN NEW(LSP, SUBRANGE) i 
WITH LSP~, [_CP~ DO 

BEGIN RANGETYPE := IDTYPEi FORM := SU3RANGE; 
IF STRGTYPE(RANGETYPE) THEN 

BEGIN ERR0RQ48); RANGETYPE := NIL END? 
MIN := VALUES; SIZE := INTSIZE 
END; 
IF SY = COLON THEN INSYMBOL ELSE ERR0R(5); 
C0NSTANT(FSYS,LSP1,LVALU) ; 
LSP^.MAX := LVALU! 
IF LSP*. RANGETYPE <> LSP1 THEN ERRORU07) 

ELSE 

BEGIN LSP := LCP A ,IDTYPE; 

IF (LSP = STRGPTR) AND ( SY = LBRACK) THEN 
BEGIN INSYMBOL; 

CONSTANTCFSYS + CRBRACKDtLSPl , LVALU) ; 
IF LSP1 = INTPTR THEN 
BEGIN 

IF (LVALU. IVAL <= 0) OR 

(LVALU. IVAL > STRGLGTH) THEN 
BEGIN ERROR(203); 

LVALU. IVAL := DEFSTRGLGTH 
END; 
IF LVALU. IVAL <> DEFSTRGLGTH THEN 

BEGIN NEW(LSP,ARRAYStTRUEtTRUE)l 
LSP* := STRGPTR*; 
WITH LSP%LVALU DO 

BEGIN MAXLENG := IVAL? 

SIZE := (IVAL+CHRSPERWD) DIV CHRSPERWD 
END 

END 

END 

ELSE ERR0R(15); 

IF SY = RBRACK THEN INSYMBOL ELSE ERR0RU2) 

END 

ELSE 

IF LSP = INTPTR THEN 
IF SY = LBRACK THEN 
BEGIN INSYMBOL? 
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NEw(LSP.LONGlNT) ; 

ISP" := LONGINTPTR*; 

CONSTANTiFSYS + CRBRACKD* LSP1 t LVALU ) ; 

IF LSP1 = INTPTR THEM 

IF (LVALU. IVAL <= 0) OR 

(LVALU. IVAL > MAXDEC) THEN ERROR(203) 
ELSE 

LSP A .SIZE := DECSIZE(LVALU.IVAL) 
ELSE ERR0R(15) ; 

IF SY = RBRACK THEN INSYMBOL ELSE ERROR(12)5 
END 
ELSE 

IF LSP A .FORM = FILES THEN 
IF INMODULE THEN 

IF NOT ININTERFACE THEN 

ERR0R(191); (*NO PRIVATE FILES*) 
IF LSP <> NIL THEN FSIZE := LSP A .SIZE 
END 
END (*SY = IDENT*) 
ELSE 

begin new(lsp, subrange); lspa.form := subrange; 
constant(fsys + ccolond* lsp1»lvalu) i 
if strgtype(lspl) then 

begin err0ru48); lsp1 := nil end; 
with lsp" do 

begin rangetype:=lspi; min:=lvalu; size:=intsize end; 
if sy = colon then insymbol else err0r(5); 

CONSTANT<FSYS.LSPltLVALU) ; 
LSP". MAX := LVALU; 

IF LSP^.RANGETYPE <> LSP1 THEN ERRORU07) 
END; 
IF LSP <> NIL THEN 
WITH LSP~ DO 

IF FORM = SUBRANGE THEN 
IF RANGETYPE <> NIL THEN 

IF RANGETYPE = REALPTR THEN ERR0R(399) 
ELSE 

if min.ival > max. ival then 
begin err0ru02); max. ival := min.ival end 
end; 

FSP := LSP; 



900 


12 


3:3 


47 


901 


12 


3:^ 


57 


902 


12 


3:2 


71 


903 


12 


3:i 


71 


904 


12 


3:0 


74 


905 


12 


3:0 


02 


906 


12 


4:d 


3 


907 


12 


4:0 


4 


908 


12 


4:0 





909 


12 


4:1 


3 


910 


12 


4:2 


12 


911 


12 


4:3 


15 


912 


12 


4:3 


19 


913 


12 


4:3 


19 


914 


12 


4:5 


29 


915 


12 


4:6 


37 


916 


12 


4:7 


42 


917 


12 


4:e 


45 


918 


12 


4:8 


52 


919 


12 


4:9 


57 


920 


12 


4:0 


62 


921 


12 


4:0 


69 


922 


12 


4:9 


72 


923 


12 


4:7 


77 


924 


12 


4:5 


79 


925 


12 


4:3 


81 


926 


12 


4:5 


89 


927 


12 


4:6 


98 


928 


12 


4:6 


03 


929 


12 


4:7 


08 


930 


12 


4:8 


11 


931 


12 


4:7 


11 


932 


12 


4:5 


15 


933 


12 


4:3 


15 


934 


12 


4:0 


34 


935 


12 


4:0 


48 


936 


12 


5:d 


1 


937 


12 


5:d 


6 


938 


12 


5:d 


16 


939 


12 


5:d 


20 


940 


12 


s:d 


22 



END 



IF NOT (SY IN FSYS) THEN 

BEGIN ERROK(6)5 SKIP(FSYS) END 
END 

ELSE FSP := NIL 
(♦SIMPLETYPE*) ! 



FUNCTION PACKABLE(F 
VAR LMIN. LMAX: IN 
BEGIN PACKABLE := F 
IF (FSP <> NIL) A 
WITH FSP* DO 
CASE FORM OF 
SUBRANGE, 

scalar: IF 



sp: stp): boolean; 
teger; 

ALSE; 

ND PACKIMG THEN 



power: 



IF 



END 



END <* CASES 
(*PACKABLE*) ; 



(FSP <> INTPTR) AND (FSP <> REALPTR) 
BEGIN GETBOUNDS(FSP*LMIN,LMAX); 
IF LMIN >= THEN 

BEGIN PACKABLE := TRUE? 
NUMBITS := l; LMIN := 1? 
WHILE LMIN < LMAX DO 

BEGIN LMIN := LMIN + 1 ; 
LMIN := LMIN + LMIN - U 
NUMBITS := NUMBITS + 1 
END 
END 

end; 

packable(elset) then 
begin getbounds(elset,lmln»lmax) ; 
lmax := lmax + 15 
if lmax < bitsperwd then 
8egin packable := true; 
numbits 1= lmax 

END 
END 

*); 



THEN 



procedure fieldlist(fsys: setofsys; var frecvar; stp) ? 
var lcp,lcpi»nxt*nxti,last: ctp; lsp»lspi»lsp2»lsp3»lsp4: stp; 
minsize*maxsize,lsize: addrrange; lvalu: VALU; 

MAXBIT.MINBIT: BITRANGE; 
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PROCEDURE ALLOCATECFCPI CTP); 

VAR ONBOUND: BOOLEAN; 
BEGIN ONBOUND : = FALSE; 
WITH FOP* 00 

IF PACKABLE(IDTYPE) THEN 
BEGIN 

IF (NUMBITS + NEXT3IT) > BITSPERWD THEN 

BEGIN DISPL := DISPL + 1; NEXTBIT := 0! 
FLDADDR := DISPL? FISPACKD ;= TRUE; 
FLDWIOTH := NUMBITS; FLDRBIT := NEXTBIT; 
NEXTBIT := NEXTBIT + NUMBITS 
END 
ELSE 

BEGIN DISPL := DISPL + ORD(NEXTBIT > 0); 
NEXTBIT := 0; ONBOUND := TRUE; 
FISPACKD != FALSE; FLDADDR := DISPL; 
IF IDTYPE <> NIL THEN 

DISPL := DISPL + IDTYPE^.SIZE 
END! 

<> NIL) THEN 
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ONBOUND J= TRUE END; 



IF ONBOUND AND (LAST 
WITH LAST* DO 

IF FISPACKD THEN 
IF FLDRBIT = 
ELSE 

IF (FLDWIDTH 



THEN FISPACKD := FALSE 



BEGIN 
END (*ALLOCATE*) i 



<= 8) AND (FLDRBIT <= 8) THEN 
FLDWIDTH := 8; FLDRBIT := 8 END 



procedure variantlist; 

vaR gottagname: boolean; 
begin new(lsp,tagfld) 5 

with lsp* do 

BEGIN TAGFIELDP := NIL; FSTVAR ;= NIL? FORM := TAGFLD END; 

frecvar := lsp5 

insymbol; 

if sy = ident then 

BEGIN 

IF PACKING THEN NEW ( LCP, FIELD. TRUE) 
ELSE NEW(LCP,FIELD»FALSE) ; 
WITH LCP* DO 

BEGIN IDTYPE := NIL; KLASS ; =FIELD; 
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next := nil; fispackd := false 

end; 

gottagname := false; pkterr ;= false; 

SEARCHID(CTYPES:,LCP1) ; PRTERR := TRUE; 
IF LCP1 = NIL THEN 

BEGIN GOTTAGNAME := TRUE? 

LCP^.NAME := ID; ENTERID(LCP); INSYMBOL; 

IF SY = COLON THEN INSYMBOL ELSE ERR0R(5) 

end; 

IF SY = IDENT THEN 

BEGIN SEARCHID(CTYPES3«LCP1) ; 
LSPl := LCPl'MDTYPEi 
IF LSPl <> NIL THEN 
BEGIN 

IF LSPl*. FORM <= SUBRANGE THEN 
BEGIN 

IF C0MPTYPES(REALPTR,LSP1) THEN ERRORU09M 
LCP^.IDTYPE 1= LSPl? LSP*.TAGFIELDP := LCPI 
IF GOTTAGNAME THEN ALLOCATE(LCP) 
END 
ELSE ERROR(llO) 

end; 
insymbol 

END 

ELSE BEGIN ERR0R(2>; SKIP(FSYS + COFSY»LPARENT3) END 
END 

ELSE BEGIN ERRORC2); SKIP(FSYS + C0FSY«LPARENT3) END; 

LSP*.SIZE := DISPL + ORD(NEXTBIT > 0); 

IF SY = OFSY THEN INSYMBOL ELSE ERR0R(8); 

LSPl := NIL; MINSIZE := DISPL; MAXSIZE != DlSPLl 

MINBIT := NEXTBIT; MAXBIT := NEXTBIT; 

REPEAT LSP2 := NIL? 

REPEAT CONSTANT{FSYS + CCOMMA, COLON, LPARENT3f LSP3, LVALU) ? 
IF LSP A .TAGFIELDP <> NIL THEN 

IF NOT C0MPTYPES(LSP*.TAGFIELDP*.IDTYPE.LSP3) THEN 
ERROR(Hl) ? 
NEW(LSP3, VARIANT) ; 
WITH LSP3* DO 

BEGIN NXTVAR := LSPl? SUBVAR := LSP2? 

VARVAL := LVALU? FORM := VARIANT 
END? 
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LSP1 := LSP3; LSP2 := LSP3? 

test := sy <> comma; 
if not test then insym8ql 
until test; 

IF SY = COLON THEN INSYM30L ELSE ERR0R(5); 
IF SY = LPARENT THEN INSYM30L ELSE ERR0R(9); 
IF SY = RPARENT THEN LSP2 := NIL 
ELSE 

FIELDLIST(FSYS + CRPARENT»SEMIC0L0N3,LSP2) ? 
IF DISPL > MAXSIZE THEN 

BEGIN MAXSIZE := DISPL; MAXBIT := NEXTBIT END 
ELSE 

IF (DISPL = MAXSIZE) AND (NEXTBIT > MAXBIT) THEN 
MAXBIT := NEXTBIT; 
WHILE LSP3 <> NIL DO 

BEGIN LSP4 := LSP3*.SUBVAR5 LSP3%SUBVAR := LSP2; 
LSP3^ f sIZE := DISPL + 0RD(NEXTBIT > 0); 
LSP3 :r LSP4 

end; 

IF SY = RPaRENT THEN 
BEGIN INSYMBOL5 

IF NOT (SY IN FSYS + C SEMICOLON}) THEN 

BEGIN ERR0R(6); SKIP(FSYS + CSEMIC0L0N3) END 
END 
ELSE ERR0R(4); 
TEST := SY <> SEMICOLON; 
IF NOT TEST THEN 
BEGIN INSYMBOL? 

DISPL := MINSIZE! NEXTBIT := MINBIT 
END 

until (test) or (sy = endsy); (* «« smf 2-28-78 *) 
displ := maxsize; nextbit := maxbit; 
lsp^.fstvar := lsp1 
end (*variantlist*) ; 

begin (*fieldlist*) 
nxti := nil; lsp := nil; last := nil; 
if not (sy in cident* cases yd) then 

begin err0ru9)! skip(fsys + c identicasesyd ) 
while sy = ident do 

BEGIN NXT := NXTl; 
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end; 



1064 


12 


5:3 


51 


1065 


12 


5:4 


51 


1066 


12 


5:5 


56 


1067 


12 


5:6 


56 


1068 


12 


5:6 


66 


1069 


12 


5:6 


73 


1070 


12 


5:7 


76 


1071 


12 


5:a 


94 


1072 


12 


5:7 


04 


1073 


12 


5:6 


06 


1074 


12 


5:6 


09 


1075 


12 


5:6 


13 


1076 


12 


5:5 


13 


1077 


12 


5:4 


16 


1078 


12 


5:4 


22 


1079 


12 


5:5 


29 


1080 


12 


5:4 


51 


1081 


12 


5:4 


56 


1082 


12 


5:3 


60 


1083 


12 


5:3 


66 


1084 


12 


5:3 


80 


1085 


12 


5:3 


02 


1086 


12 


5:4 


07 


1087 


12 


5:3 


17 


1088 


12 


5:4 


22 


1089 


12 


5:5 


25 


1090 


12 


5:6 


34 


1091 


12 


5:6 


44 


1092 


12 


5:5 


44 


1093 


12 


5:3 


51 


1094 


12 


5:3 


54 


1095 


12 


5:4 


59 


1096 


12 


5:5 


62 


1097 


12 


5:6 


75 


1098 


12 


5:4 


97 


1099 


12 


5:2 


97 


1100 


12 


5:1 


99 


1101 


12 


5:1 


02 


1102 


12 


5:2 


07 


1103 


12 


5:3 


10 


1104 


12 


5:1 


29 



REPEAT 

IF SY = IDENT THEN 
BEGIN 

IF PACKING THEN NEW ( LCP, FIELD, TRUE ) 
ELSE NEW(LCP, FIELD, FALSE) ; 
rtlTH LCP'* DO 

BEGIN NAME := ID; IDTYPE := NIL; NEXT := NXT; 

klass := field; fispackd := false 

end; 
nxt := lcp; 
enterid(lcp) ; 
insymbol 

END 
ELSE ERR0R(2) ; 
IF NOT (SY IN CCOMMA,COLON3) THEN 

Trcr G ™ ES R ^ ( J , i SKIP(FSYS + CCOMMA, COLON, SEMICOLON, CASESYJ) 
lt.01 •— SY v> COMMA; 

IF NOT TEST THEN INSYMBOL 
UNTIL TEST; 

IF SY = COLON THEN INSYMBOL ELSE ERR0R(5); 
TYPtFSYS + CCASESY,SEMIC0L0N3»LSP,LSIZE)J 
IF LSP <> NIL THEN 

IF LSP^.FORM = FILES THEN ERROR(108); 
WHILE NXT <> NXT1 DO 
WITH NXT* DO 

BEGIN IDTYPE := LSP; ALLOCATE (NXT) ; 
IF NEXT = NXT1 THEN LAST := NXT; 
NXT := NEXT 

end; 
nxti := lcp; 
if sy = semicolon then 
begin insymbol; 

IF D ^I l tl IN CIDEN T,ENDSY,CASESY3) THEN (* «« SMF 2-28-78 
BEGIN ERR0RU9); SKIP(FSYS + C IDENT, CASESYU) END 
END 

end (*while*); 
nxt := nil; 
while nxti <> nil do 

with nxti" do 

BEGIN LCP := NEXT; NEXT := NXT; NXT .'= NXTl ; NXTI := LCP END* 
IF SY = CASESY THEN VARIANTLIST ' 



end; 



*) 
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ELSE FRECVAR ;= NIL 
END (*FIELDLIST*) 5 

PROCEDURE POINTERTYPE; 

BEGIN NEW(LSPtPOlNTER) 5 FSP := LSP; 

with lsp" do 

3egin eltype := nil; size := ptrsize; form := pointer end; 
insymbou 

if sy = ident then 
begin prterr := false; 
searchid(ctypes3«lcp) ; prterr := true; 
if lcp = nil then (+forward referenced type id*) 
begin new(lcp, types); 
with lcp~ do 
begin name := id; idtype := lsp? 
next := fwptr; klass := types 
end; 
fwptr := lcp 

END 
ELSE 
BEGIN 

IF LCP". IDTYPE <> NIL THEN 

IF (LCP". IDTYPE". FORM <> FILES) OR SYSCOMP THEN 

LSP". ELTYPE := LCP". IDTYPE 
ELSE ERRORQ08) 
END? 

insymbol; 

END 
ELSE ERR0R(2) 
END (*POINTERTYPE*) ! 

BEGIN (*TYP*) 

PACKING != FALSE; 

IF NOT (SY IN TYPEBEGSYS) THEN 

BEGIN ERROR(IO)' SKlPtFSYS + TYPEBEGSYS) END; 
IF Sy IN TYPEBEGSYS THEN 
BEGIN 

IF SY IN SIMPTYPEBEGSYS THEN SIMPLETYPE (FSYS ,FSP»FSIZE ) 
ELSE 
(*"*) IF SY = ARROW THEN POINTERTYPE 
ELSE 
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TYPEDELS) END 



BEGIN 

IF SY = PACKEDSY THEN 

begin insymbol; packing : = true; 

IF NOT (SY IN TYPEDELS) THEN 
BEGIN ERROR(IO); SKIP(FSYS + 
END? 

(♦ARRAY*) IF SY = ARRAYSY THEN 
BEGIN INSYMBOL; 

IF SY = LBRACK THEN INSYMBOL ELSE ERROR(U); 

LSP1 := NIL; 

REPEAT 

IF PACKING THEN NEW (LSPt ARRAYS* TRUE. FALSE) 
ELSE NEWtLSP, ARRAYS, FALSE); 
WITH LSP* DO 

BEGIN AELTYPE := LSP1 ? INXTYPE := NIL; 

IF PACKING THEN AISSTRNG 1= FALSE? 

AISPACKD := FALSE! FORM : = ARRAYS 
END; 
LSPi := lsp; 

LSPl%IlZE^= Y fsi ^ 0MMA,RBRACK ' 0FSY: >'LSP2,LSIZE) « 
IF LSP2 <> NIL THEN' 

IF LSP2*.F0RM <= SUBRANGE THEN 
BEGIN 

IF LSP2 = REALPTR THEN 

BEGIN ERR0RUQ9); LSP2 := NIL END 
ELSE 

IF LSP2 = INTPTR THEN 

BEGIN ERR0RU49M LSP2 := NIL END; 
LSP*. INXTYPE := LSP2 
END 

ELSE BEGIN ERR0RU13); LSP2 := NIL END? 
TEST := SY <> COMMA; 
IF NOT TEST THEN INSYMBOL 
UNTIL TEST? 

IF SY = RBRACK THEN INSYMBOL ELSE ERR0R(12)? 
IF SY = OFSY THEN INSYMBOL ELSE ERR0R(8); 
TYP(FSYS,LSP,LSIZE)? 
IF LSP <> NIL THEN 

IF LSP-.FORM = FILES THEN ERROR(108)J 
IF PACKABLE(LSP) THEN 
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IF NUMBITS + NUMBITS <= BITSPERWD THEN 
WITH LSP1 A DO 

BEGIN AISPACKD := TRUE? 

ELSPERWD := BITSPERWD DIV NUMBITS; 
ELWIDTH := NUMBITS 
END; 
REPEAT 

WITH LSP1* DO 

BEGIN LSP2 := AELTYPE; AELTYPE := LSP; 
IF INXTYPE <> NIL THEN 

BEGIN GETBOUNDS(INXTYPEtLMINtLMAX) ; 
IF AISPACKD THEN 

LSIZE := (LMAX-LMIN+ELSPERWD) 

DIV ELSPERWD 
ELSE 

LSIZE := LSIZE*(LMAX - LMIN + 1)5 
IF LSIZE <= THEN 

BEGIN ERR0R<398>; LSIZE ;= 1 END; 
SIZE := LSIZE 
END 
END; 
LSP := LSP15 LSP1 := LSP2 
UNTIL LSP1 = NIL 
END 
ELSE 

IF SY = RECORDSY THEN 
BEGIN INSYMB0L5 
OLDTOP := TOP; 
IF TOP < DISPLIMIT THEN 
BEGIN TOP := TOP + 1! 
WITH DISPLAYCTOPD DO 

BEGIN FNAME := NIL? OCCUR := REC END 
END 
ELSE ERROR(250); 
displ := 0; NEXTBIT := o; 

FlELDLlST(FSYS-CSEMIC0L0N3+CENDSYDtLSPl); 
DISPL := DISPL + 0RD(NEXTBIT > 0); 
NEW(LSP.RECORDS) ; 
WITH LSP" DO 

BEGIN FSTFLD := DISPLAYCTOP3. FNAME ; 
RECVAR := LSP1! SIZE := DISPL; 
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THEN INSYMBOL ELSE ERR0R(13) 



FORM := RECORDS 
END; 
top := OLDTOP; 
IF SY = ENDSY 
END 
ELSE 

IF SY = SETSY THEN 
BEGIN INSYM30L5 

IF SY = OFSY THEN INSYMBOL ELSE ERR0RC8); 
SIMPLETYPE(FSYS»LSP1.LSIZE) J 
IF LSP1 <> NIL THEN 

IF (LSPl". FORM > SUBRANGE) OR 

(LSP1 = INTPTR) OR (LSPl = REALPTR) THEN 
BEGIN ERR0RU15M LSPl := NIL END 
ELSE 

IF LSPl = REALPTR THEN 

BEGIN ERR0RU14); LSPl := NIL END? 
NEWUSP, POWER) J 
WITH LSP~ DO 

BEGIN ELSET := LSPl; FORM := POWER? 
IF LSPl <> NIL THEN 

BEGIN GETB0UNDS(LSP1,LMIN»LMAX); 

SIZE := UMAX + BITSPERWD) DIV BITSPERWO; 
IF SIZE > 255 THEN 

BEGIN ERR0RU69); SIZE := 1 END 

END 
ELSE SIZE := 
END 
END 
ELSE 

IF SY = FILESY THEN 
BEGIN 

IF INMODULE THEN 

IF NOT ININTERFACE THEN 

ERR0R(191>; (*NO PRIVATE FILES*) 
INSYMBOL; NEWUSP, FILES) J 
WITH LSP~ DO 

BEGIN FORM := FILES; FILTYPE := NIL END; 
IF SY = OFSY THEN 

BEGIN INSYMBOL; TYP(FSYS,LSP1 USIZE) END 
ELSE LSPl := NIL; 
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LSP~.FILTYPE := LSPl; 
IF LSPl <> NIL THEN 

LSP".SIZE := FILESIZE + LSPl". SIZE 
ELSE LSP^.SIZE := NILFILESIZE 
END; 
FSP : = LSP 

end; 
if not (sy in fsys) then 
begin err0r(6); skip(fsys) end 

END 
ELSE FSP := NIL; 

IF FSP = NIL THEN FSIZE := 1 ELSE FSIZE := FSP". SIZE 
END (*TYP*> ? 

*$i *5:decpart.a.text*> 
*$i #5:decpart.b.text*> 
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PROCEDURE USESDECLARATION(MAGIC: BOOLEAN); 
LABEL l; 
TYPE DCREC = RECORD 

DISKADDR: INTEGERS 
CODELENG: INTEGER 
END! 

var segdict: record 

dandc: arraycsegrange3 of dcrec; 
segname: arraycsegrange3 of alpha} 
segkind: arraycsegrange3 of integer; 
textaddr: arraycsegrange3 of integer; 
filler: arrayc0..127d of integer 

END! 

found: boolean; begaddr: integer; 

lcp: ctp; llexstk: lexstkrec; lname: alpha; 

lsy: symbol; lop: operator; lid: alpha; 

procedure gettextuar found: boolean); 
var lcp: ctp; segindex: integer; 

begin found := false; 
lcp := modptr5 
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WHILE (LCP <> NIL) AND NOT FOUND DO 

IF LCP'*. NAME = ID THEN FOUND := TRUE ELSE LCP := LCP^.NEXT; 

IF FOUND THEN 
3EGIN 

LSEPPROC := SEGTABLECLCP-.SEGIDH.SEGKIND = 4; 
IF NOT LSEPPROC THEN 

BEGIN SEG := LCP^.SEGID; NEXTPROC := 1 END; 
BEGADDR := SEGTABLECLCP*. SEGID3.TEXTADDR ; 
USEFILE ;= WORKCODE; 
END 
ELSE 

BEGIN FOUND := TRUE; 
IF LIBNOTOPEN THEN 

BEGIN RESET(LIBRARYiSYSTEMLIB); 

IF IORESULT <> THEN BEGIN ERR0RU87); FOUND ;= FALSE END 

IF BLOCKREAD(LIBRARYtSEGDlCT.ltO) <> 1 THEN 

begin err0r(187){ found := false end? 
end; 
if found then 

BEGIN LIBNOTOPEN := FALSE; 

SEGINDEX ;= 0; FOUND := FALSE; 
WHILE (SEGINDEX <= MAXSEG) AND (NOT FOUND) DO 
IF MAGIC THEN 

IF SEGDICT.SEGNAMECSEGINDEX3 = LNAME THEN FOUND :* TRUE 
ELSE SEGINDEX := SEGINDEX + 1 
ELSE 

IF SEGDICT.SEGNAMECSEGINDEX3 = ID THEN FOUND is TRUE 
ELSE SEGINDEX := SEGINDEX + 1; 
IF FOUND THEN 

BEGIN USEFILE := SYSLIBRARY; 

BEGADDR := SEGDICT.TEXTADDRCSEGINDEX3; 
LSEPPROC := SEGDICT.SEGKINDCSEGINDEX3 = 4; 
IF NOT LSEPPROC THEN 
BEGIN 

IF MAGIC THEN SEG := 6 
ELSE 

BEGIN SEG := nextseg; 
NEXTSEG := NEXTSEG + 1; 
IF NEXTSEG > MAXSEG THEN ERR0R(250) 
END; 
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WITH SEGTA3LECSEGH DO 

BEGIN OISKADDR := 0; CODELENG := 0! 

SEGNAME := SEGDICT.SEGNAMECSEGINDEX3; 
IF INMODULE OR MAGIC THEN SEGKIND := 
ELSE SEGKIND := SEGDICT.SEGKINDCSEGINDEXU; 
TEXTADDR := 
END; 
NEXTPROC := 1 
END 

END 
ELSE ERROR(190) (*NOT IN LIBRARY*) 

END 

end; 
if begaddr = then begin err0r(195); found := false end? 
if found then 

BEGIN 

USING := TRUE; 

PREVSYMCURSOR := SYMCURSORJ 

PREVLINESTART := LINESTARTJ 

PREVSYMBLK := SYMBLK - 2» 

SYMBLK := BEGADDR; GETNEXTPAGE? 

INSYMBOL 
END 
END (*GETTEXT*) ; 

BEGIN <*USESDECLARATION*) 

IF LEVEL <> 1 THEN ERR0R(189)J 

IF INMODULE AND NOT ININTERFACE THEN ERR0RU92); 

IF NOT MAGIC THEN DLINKERINFO := TRUE; 

IF NOT USING THEN USINGLIST := NIL; 

REPEAT 

IF (NOT MAGIC) AND (SY <> IDENT) THEN ERR0R(2) 
ELSE 

IF USING THEN 

BEGIN LCP := USINGLISTJ 
WHILE LCP <> NIL DO 

IF LCP". NAME = ID THEN GOTO 1 
ELSE LCP ;= lcp^.next; 

ERR0R(188) (*UNIT MUST BE PREDECLARED IN MAIN PROG*); 
i: 

END 
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:= 'TURTLE 

lop := op; 



* » 

LID 



:= id 



:= id 



WRITELN(OUTPUTiID, 
iSCREEND0TS:4» •>» ) 



:= seg; soldproc := nextproc end; 



ELSE 
BEGIN 

IF MA3IC THEN 
BEGIN LNAME 

lsy := SY 

END 
ELSE 

BEGIN LNAME 

WRITELN(OUTPUT) ; 
WRlTE(OUTPUTi •<• 
END; 
WITH LLEXSTK DO 
BEGIN DOLDSEG 
GETTEXT(FOUND) 5 
IF FOUND THEN 
BEGIN 

NEwUCP, MODULE); 
WITH LCP* DO 

BEGIN NAME := LNAME; NEXT := USINGLIST; 
IDTYPE := NIL; KLASS := MODULE; 
IF LSEPPROC THEN SEGID := -1 (*NO SEG*) 
END; 

ENTERID(LCP) ; 

USINGLIST := LCP! 

DECLARATI0NPART(FSYS + CENDSYD)! 

IF NEXTPR0C=1 (*N0 PROCS DECLARED*) THEN 

LCP A . SEGID := -11 UNO SEG*) 
SYMBLK := 9999; (*F0RCE RETURN TO SOURCEFILE*) 
GETNEXTPAGE 
END; 

if not lsepproc then 
with llexstk do 
begin seg := doldseg5 

nextproc := soldproc 
end; 
lsepproc := false; 
end; 
if not magic then 
begin insymbol; 

TEST := SY <> 
IF TEST THEN 



C , tMEMAVAIL:5t» WORDS}') 



ELSE SEGID := SEG 



COMMAS 
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insymbol else err0r(14) 
:= lop; id := lid end; 



IF SY <> SEMICOLON THEN ERROR(20) 
ELSE 
ELSE INSYMBOL 
END 
UNTIL TEST OR MAGIC; 
IF NOT MAGIC THEN 

IF SY = SEMICOLON THEN 
ELSE BEGIN SY := LSY? OP 
IF NOT USING THEN 
BEGIN 

IF INMODULE THEN USINGLIST := NIL; 
CLOSE(LIBRARY,LOCK) ; 
LIBNOTOPEN := TRUE 
END 
END UUSESDECLARATION*) 5 

PROCEDURE LABELDECLARATION; 

VAR LLP: LABELP! REDEF: BOOLEAN; 
BEGIN 
REPEAT 

IF SY = INTCONST THEN 
WITH DISPLAYCTOPD DO 

BEGIN LLP := FLABEL; REDEF ;= FALSE; 
WHILE (LLP <> NIL) AND NOT REDEF DO 
IF LLP^.LABVAL <> VAL.IVAL THEN 

LLP := LLP^.NEXTLAB 
ELSE BEGIN REDEF := TRUE; ERR0R(166) END; 
IF NOT REDEF THEN 

begin new(llp) ; 
with llp* do 
begin labval := val.ival; 
codelbp := nil; nextlab := flabel 

END; 
FLABEL := LLP 
END; 
INSYMBOL 
END 
ELSE ERR0R(15) « 
IF NOT ( SY IN FSYS + CCOMMA* SEMICOLONS ) THEN 

BEGIN ERR0R{6) ; SKIP ( FSYS+CCOMMA* SEMICOLON}) END; 
TEST := SY <> COMMA; 
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if not test then insymbol 
until test; 

if sy = semicolon then insym30l else err0r(14) 
end (* labeldeclaration *) : 

procedure constdeclaration; 
var lcp: ctp; lsp: stp; lvalu: valu; 

BEGlM 

IF SY <> IDENT THEN 

3EGIN ERROR(2)5 SKlP(FSYS + CIDENTD) END; 
WHILE SY = IDENT DO 
BEGIN NEW(LCPiKONST) ; 
WITH LCP* DO 

BEGIN NAME := ID; IDTYPE := NIL! 

NEXT : = NIL; KLASS := KONST 
END; 
INSYMBOL; 

IF (SY = RELOP) AND (OP = EOOP) THEN INSYMBOL ELSE ERR0R(16): 
CONSTANT(FSYS ♦ CSEMICOLOND.LSP.LVALU) ; "" 

ENTERID(LCP)! 

LCP'*. IDTYPE := LSP{ LCP*. VALUES != LVALU; 
IF SY = SEMICOLON THEN 
BEGIN INSYMBOL? 

IF NOT (SY tH FSYS + CIDENTD) THEN 

BEGIN ERR0R(6); SKIP(FSYS + CIDENT3) END 
END 
ELSE 

IF NOT ((SY = ENDSY) AND (INMODULE)) THEN ERR0RU4) 

END (*CONSTDECLARATION*) ; 
PROCEDURE TYPEDECLARATION; 

var lcp,lcpi,lcp2: ctp; lsp: stp; lsize: addrrange; 

oEGIN 

IF SY <> IDENT THEN 

BEGIN ERR0R(2)! SKIP(FSYS + CIDENTD) END? 
WHILE SY = IDENT DO 
3EGIN NEW(LCPiTYPES) 5 
WITH LCP* DO 

BEGIN NAME := ID; IDTYPE := NIL; KLASS := TYPES END? 
INSYMBOL J 
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IF (SY - RELOP) AND (OP = EQOP) THEN INSYMBOL ELSE ERR0R(16); 
TYPtFSYS + CSEMICOLON3iLSP,LSIZE) ! 

enterio(lcp) 5 
lcp^.idtype := lsp; 
lcpi := fwptk; 
while lcpi <> nil do 

BEGIN 

IF LCPl^.NAME = LCP^.NAME THEN 
3EGIN 

LCP1'\IDTYPE~.ELTYPE := LCP^.IDTYPE; 
IF LCPI <> FWPTR THEN 

LCP2~.NEXT := LCPl^.NEXT 
ELSE FWPTR := LCPI*. NEXT; 
END; 

lcp2 := lcpi; lcpi := lcpi*. next 
end; 
if sy = semicolon then 
3egin insymbol; 
if not (sy in fsys + cident3) then 
begin error(6)5 skip(fsys + cident3) end 

END 
ELSE 

if not ((sy = endsy) and (inmodule)) then err0ru4) 
eno; 
if fwptr <> nil then 

BEGIN ERR0RQ17); FWPTR := NIL END 
END (*TYPEDECLARATI0N*) ; 

PROCEDURE VARDECLARATION; 

var LCPtNXT»iDLisT: ctp; lsp: stp; lsize: addrrange; 
begin nxt := nil; 
repeat 

REPEAT 

IF SY = IDENT THEN 
BEGIN 

if inmodule then new ( lcp* actualvars.true ) 
else new(lcp, actualvars. false) ; 
with |_cp~ do 
begin name := id; next := nxt; klass := actualvars; 

idtype := nil; vlev := level; 

if inmodule then 
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if ininterface then public := true 
else public := false 

end; 

Ef\iTERlC(LCP) ! 
NXT := LCP; 
INSYM30L5 
END 
ELSE ERR0R(2) ; 
IF NOT <SY IN FSYS + CCOMMAiCOLONU + TYPEDELS) THEN 

BEGIN ERR0R{6); SKIP ( FSYS+CCOMMA .COLONt SEMICOLOND+TYPEDELS) END? 
TEST := SY <> COMMA; 
IF NOT TEST THEN INSYMBOL 
UNTIL TEST? 

IF SY = COLON THEN INSYMBOL ELSE ERR0R<5); 
IDLIST := NXT! 

TYP(FSYS + CSEMICOLOND + TYPEDELS, LSP,LSIZE) ; 
WHILE NXT <> NIL DO 
WITH NXT'* DO 

BEGIN IDTYPE := LSP; VADDR := LC; 

lc := lc + lsize; nxt := next; 
if next = nil then 

IF LSP <> NIL THEN 

IF LSP'*. FORM = FILES THEN 

BEGIN (*PUT IDLIST INTO LOCAL FILE LIST*) 
NEXT := DISPLAYCTOP3.FFILE; 
DISPLAYCTOPD.FFILE := IDLIST 
END 

end; 
if sy = semicolon then 
begin insymbol; 
if not (sy in fsys + cidentd) then 
begin err0r(6); skip(fsys + cident3) end 

END 
ELSE 

IF NOT (<SY = ENDSY) AND (INMODULE)) THEN ERR0RU4) 
UNTIL (SY <> IDENT) AND NOT (SY IN TYPEDELS); 
IF FWPTR <> NIL THEN 

BEGIN ERR0R(117); FWPTR := NIL END 
END <*VARDECLARATI0N*) ; 
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f?5: JlCPAKT.cJ. text*) 

j*5:decpart.ctext*> 

copyright (c) 1979, regents of the *) 
university of california* san diego *> 

procedure procdeclaratlon(fsy: symbol; segdec: boolean); 
var lsy: symbol; lcpiLCpi: ctp; lsp: stp; 
extonlyiforw: boolean; 
lcm: addrrange; 
llexstk: lexstkrec; 

procedure parameterlistifsy: setofsys; var fpar: ctp; fcp: ctp>? 
var lcp»lcpi,lcp2,lcp3: ctp; lsp: stp; lkind: idkind; 
llclen : addrrange; count : integer; 
begin lcpi := nil; llc := lc; 

IF NOT (SY in fsy + CLPARENTD) then 

BEGIN ERR0R(7); SKIP(FSYS + FSY + CLPARENTD) END; 
IF SY = LPARENT THEN 

BEGIN IF FORW THEN ERROR(119)5 
INSYMBOL; 
IF NOT (SY IN CIDENT,VARSY3) THEN 

BEGIN ERR0R(7); SKIP(FSYS + C IDENT,RPARENT3) END; 
WHILE SY IN CIDENT.VARSY3 DO 
BEGIN 

IF SY = VARSY THEN 

BEGIN LKIND := FORMAL; INSYMBOL END 
ELSE LKIND := ACTUAL; 
LCP2 := NIL; 
COUNT := 0? 
REPEAT 

IF SY <> IDENT THEN ERR0R(2) 
ELSE 
BEGIN 

NEW(LCP.FORMALVARS, FALSE); (*MAY BE ACTUAL(SAME SIZE)*) 
WITH LCP~ DO 

BEGIN NAME := ID; IDTYPE := NIL; NEXT := LCP2* 
IF LKIND = FORMAL THEN KLASS := FORMALVARS 
ELSE KLASS := ACTUALVARS; VLEV := LEVEL 
END; 
ENTERID(LCP) 5 



1636 

1637 

1638 

1639 

1640 

1641 

1642 

1643 

1644 

1645 

1646 

1647 

1648 

1649 

1650 

1651 

1652 

1653 

1654 

1655 

1656 

1657 

1658 

1659 

1660 

1661 

1662 

1663 

1664 

1665 

1666 

1667 

1668 

1669 

1670 

1671 

1672 

1673 

1674 

1675 

1676 



12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 



16 

16 
16 
16 
16 
1618 

16:7 

16:6 

16:& 

16:5 

16:5 

16:5 

16:6 

16:7 

16:8 

16:9 

16:9 

16:9 

16:9 

16:9 

i6:o 

i6:i 

i6:i 

16:2 

16:9 

16:8 

16:7 

16:6 

16:5 

16:6 

16:7 

16: 6 

i6:s 

16:6 

16:5 

16:5 

16 .'6 

16:7 
16: 8 
16:9 
I6:s 



65 

93 

93 

96 

10 

14 

25 

28 

33 

37 

43 

46 

51 

54 

59 

59 

68 

71 

75 

78 

83 

88 

95 

00 

10 

12 

17 

20 

23 

25 

30 

30 

40 

54 

72 

78 

83 

86 

89 

94 

94 



LCP2 := LCP; COUNT := COUNT + 1; 
INSYMBOL 
END; 

IF NOT (SY IN FSYS + C COMMA , SEMICOLON , COLONU ) THEN 
BEGIN ERROR(7) ; 

SKIP(FSYS + CCOMMA, SEMICOLON, RPARENT, COLONS) 
END ! 

TEST := SY <> COMMA! 

IF NOT TEST THEN INSYMBOL 
UNTIL test; 
lsp := nil; 
if sy = colon then 

begin insymbol; 

IF SY = IDENT THEN 
BEGIN 

searchid(ctypes3,lcp) ; 

insymbol? 

lsp := lcp~.idtype; 

len := ptrsize; 

if lsp <> nil then 

IF LKIND = ACTUAL THEN 

IF LSP*. FORM = FILES THEN ERR0RU21) 
ELSE 

IF LSP*. FORM <= POWER THEN LEN := LSP*. SIZE; 
LC := LC + COUNT * LEN 
END 
ELSE ERROR<2> 
END 
ELSE 

IF LKIND = FORMAL THEN 

EXTONLY := TRUE 
ELSE ERR0RC5) • 
IF NOT (SY IN FSYS + CSEMICOLONtRPARENT]) THEN 
LCP3 G := LCP2? (?)I ^ IP(F ? YS + CSEMICOLON.RPARENT3) END; 

WHILE LCP2 <> NIL DO 
BEGIN LCP ,'r LCP2; 
WITH LCP2* DO 

BEGIN IDTYPE := LSP; 

LCP2 := NEXT 
END 
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END! 
IF LCP <> NIL THEN 

BEGIN LCP A .NEXT : = LCPi; LCP1 := LCP3 END; 
IF SY = SEMICOLON THEN 
BEGIN INSYMBOL; 

IF NOT (SY IN FSYS + C IDENTt VARSY3 ) THEN 

BEGIN ERR0R(7); SKIP(FSYS + C IDENT iRPARENT 1 ) END 
END 
END (*WHILE*) ; 
IF SY = RPARENT THEN 
BEGIN INSYMBOL? 

IF NOT (SY IN FSY + FSYS) THEN 

BEGIN ERR0R(6); SKIP(FSY + FSYS) END 
END 
ELSE ERRORU); 

FCP~.LOCALLC := LC » LCP3 := NIL; 
WHILE LCPI <> NIL DO 
WITH LCPI* DO 

BEGIN LCP2 := NEXT? NEXT *.= LCP3? 
IF (IDTYPE <> NIL) THEN 

IF KLASS = FORMALVARS THEN 

BEGIN VADDR := LLC; LLC := LLC + PTRSIZE END 
ELSE 

IF KLASS = ACTUALVARS THEN 

IF (IDTYPE*. FORM <= POWER) THEN 

BEGIN VADDR != LLC 5 LLC := LLC + IDTYPE". SIZE END 
ELSE 

BEGIN VADDR := LC; 

LC := LC + IDTYPE". SIZE} 
LLC := LLC + PTRSIZE 
END; 

lcp3 := lcpi; lcpi := lcp2 

END; 
FPAR := LCP3 
END 

ELSE FPAR := NIL 
END (+PARAMETERLIST*) ; 

BEGIN (*PROCDECLARATION*) 

IF SEGDEC THEN (* SEGMENT DECLARATION *) 

BEGIN 
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IF CODEINSES THEN 

BEGIN ERROK(399)5 SEGINX:=0; CURBYTE:=0; END; 
WITH LLEXSTK UO 

BEGIN 

doloseg:=seg; 
seg:=nextseg; 
s0l0pr0c:=nextpr0c; 
end; 
nextproc:=i; 
lsy:=sy; 

if sy in cprocsy. funcsy} then insymbol 
else begin ehr0r(399); lsy:=procsy end; 
fsy:=lsy; 
end; 
llexstk. dllc := lc 5 lc := lcaftermarkstack; 

IF FSY = FUNCSY THEN LC := LC + REALSIZE? 
LINEINFO := LC; DP ;= TRUE; EXTONLY := FALSE? 
IF SY = IDENT THEN 
BEGIN 

IF USING OR INMODULE AND ININTERFACE THEN FORW := FALSE 
ELSE 

BEGIN SEARCHSECTI0N(DISPLAYCT0P3.FNAME»LCP) ; 
IF LCP <> NIL THEN 
BEGIN 

IF LCP^.KLASS = PROC THEN 

FORW ;= LCP^.FORWDECL AND (FSY = PROCSY) 
AND (LCP^.PFKIND = ACTUAL) 
ELSE 

IF LCP A .KLASS = FUNC THEN 

FORW := LCP^.FORWDECL AND (FSY = FUNCSY) 
AND (LCP~.PFKIND = ACTUAL) 
ELSE FORW :r FALSE! 
IF NOT FORW THEN ERROR(160) 
END 

else forw := false 
end; 

IF NOT FORw THEN 
BEGIN 

IF FSY = PROCSY THEN 

IF INMODULE THEN NEW ( LCP, PROC .DECLARED. ACTUAL.TRUE) 
ELSE NEW (LCP, PROC, DECLARED. ACTUAL. FALSE) 
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ELSE 

if inhodule then new ( lcp , func 1 declared* actual . true ) 
else nlinhlcp.funcdeclared.actual. false) ; 
with lcp" do 
3egin name := id; idtype := nil! locallc := lc; 
pfdeckind := declared! pfkind := actual; 
inscope := false; pflev := level; 
pfname := nextproc; pfseg := seg; 
if using then proctablecnextproc 1 := 0; 
if inmodule then 
if using then imported := true 
else imported := false; 
if segdec then 

BEGIN 

IF NEXTSEG > MAXSEG THEN ERROR(250)J 
NEXTSEG := NEXTSEG+15 
SEGTABLECSEG3.SEGNAME Ir ID 
END; 
IF NEXTPROC = MAXPROCNUM THEN ERR0R(251) 
ELSE NEXTPROC := NEXTPROC + 1* 
IF FSY = PROCSY THEN KLASS := PROC 
ELSE KLASS := FUNC 
END; 
ENTERID(LCP) 
END 
ELSE 

BEGIN LCP1 := LCP". NEXT; 
WHILE LCP1 <> NIL DO 
BEGIN 

WITH LCP1" DO 

IF IDTYPE = NIL THEN 



EXTONLY := TRUE 
ELSE 

IF KLASS 
BEGIN 
LCM : = 
IF LCM 
END 
ELSE 

IF KLASS 
BEGIN 



= FORMALVARS THEN 

= VADDR + PTRSIZE; 
> LC THEN LC := LCM 



= ACTUALVARS THEN 
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LCM := VADDR + IDTYPE% SIZE ; 
IF LCM > LC THEN LC := LCM 
END; 

LCP1 := LCP1*..MEXT 

END; 

IF SEG <> LCP*.PFSE& THEN 

BEGIN 

SEG := LCP~.PFSEG; NEXTPROC := 2; 
IF NOT SEGDEC THEN ERR0R(399) 
END 

end; 
insymbol 

END 
ELSE 

BEGIN ERR0R(2)! |_CP := UPRCPTR END; 
WITH LLEXSTK DO 

3EGIN doldlev:=level; 
doldtop:=top? 
poldproc:=curproc; 
dfprocp:=lcp; 

end; 

curproc := lcp^.pfname; 

if t0P E < displi«t\h T E H n N L " EL := L " EL + * ELSE "*<>*<«»< 

3ESIN TOP .*= TOP + 1; 
WITH DISPLAYCTOPJ DO 
BEGIN 

IF FORW THEN FNAME := LCP^.NEXT 
ELSE FNAME := NIL; 

FLABEL := NIL; FFILE := NIL; OCCUR := BLCK 

END 
END 
ELSE ERROR(250) 5 
IF FSY = PROCSY THEN 

3EGIN PARAMETERLIST(CSE*IICOLON3.LCPl,LCP) ; 

IF NOT FORW THEN LCP~.NEXT := LCP1 
END 
ELSE 

BEGIN PARAMETERLIST(CSEN|ICOLON»COLON3,LCPl,LCP) ; 
IF NOT FORW THEN LCP~.NEXT := LCPl; 
IF SY = COLON THEN 
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begin insymbol! 
if sy = ident then 
begin if forw then err0ru22); 
searchid(c types:. lcp1) ; 
lsp := lcpi^.idtype; 
lcp^.idtype := lsp; 
if lsp <> nil then 

IF NOT (LSP A .FORM IN C SCALAR , SUBRANGE . POINTER 2 ) THEN 
BEGIN ERROR(120)5 LCP'MDTYPE := NIL END; 
INSYMBOL 
END 
ELSE BEGIN ERR0R(2); SKIPtFSYS + CSEMICOLOND) END 
END 
ELSE 

if not forw then err0ru23) 

end; 

IF SY = SEMICOLON THEN INSYMBOL ELSE ERR0R(14); 
LCp-.EXTURNAL := FALSE; 
IF (SY = EXTERNLSY) 

OR ((USING) AND (LSEPPROO) THEN 
BEGIN 

IF LEVEL <> 2 THEN 

err0r(183) uexternal procs must be in outermost block*); 
if inmodule then 
if ininterpace and not using then 
err0r(184)j (*no external decl in interface*) 
if segdec then error(399)5 
with lcp* do 
begin exturnal := true; forwdecl := false; 
writeln(output) ; writeln(output. name. ' c • .memavail: 5. • wordsdmj 
wr i te( output. •<'»screend0ts. , 4»»>») 
end; 
proctableccurproc] := 0; 
olinkerinfo == true; 
if sy = externlsy then 
begin insymbol; 
if sy = semicolon then insymbol else err0r(14); 
if not (sy in fsys) then 
begin errqr(6); skip(fsys) end 

END 

END 
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ELSE 

IF USING THEN 

BEGIN LCP-.FORWOECL := FALSE; 

END 
ELSE 

IF (SY = FORWARDSY) OR INMODULE AND ININTERFACE THEN 
3EGIN 

IF FORw THEN ERR0R(161) 
ELSE LCP^.FORWDECL := TRUE; 
IF SY = FORWARDSY THEN 
BEGIN INSYMBOL? 

IF SY = SEMICOLON THEN INSYMBOL ELSE ERROR (l«f) 
END} 
IF NOT (SY IN FSYS) THEN 

BEGIN ERR0R(6); SKIP(FSYS) END 
END 
ELSE 
BEGIN 

IF EXTONLY THEN 
ERR0R(7); 

newblock:=truej 
notdone:=true; 
with llexstk do 

BEGIN 

mark<dmarkP) ; 

WITH LCP" DO 

BEGIN FORWDECL := FALSE; INSCOPE := TRUE? 
EXTURNAL := FALSE END; 

bfsy:=semicolon; 

issegment:=segdec; 

prevlexstackp:=tos; 

END; 
NEW(TOS) » 
TOS*:=LLEXSTK; 
EXIT(PROCDECLARATION); 

end; 

WITH LLEXSTK DO <* FORWARD OR EXTERNAL DECLARATION, SO RESTORE STATE *) 

BEGIN 

level:=doldlev; 

top:=doldtop; 

lc:=dllc; 
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CURPROC:=POLDPROC; 
IF SEGDEC THEN 
BEGUM 

NEXTPrtOC:=SOLDPROC; 

seg:=doldseg; 
end; 
end; 
end; (* procdeclaration *) 

begin (*declaratiqnpart*) 

if (noswap) and ( startingup ) then 

BEGIN 

STARTINGUP:=FALSE; (* ALL SEGMENTS ARE IN BY THIS TIME *) 
3L0CK(FSYS) ; 
EXIT(DECLARATIONPART) ; 

end; 

IF NOISY THEN 

UNITWRITE(3»DUMMYVARC-I6003i35)l UADJUST DISPLAY OF STACK AND HEAP*) 
REPEAT 

notdone:=false; 
if userinfo. stupid then 
if not codeinseg then 
if (level = 1) and (nextseg = 10) then 
if nqtdnmodule or using) then usesdeclaratlon (true ) j 
(*to get turtle graphics*) 
if sy = usessy then 

3egin insymbol! usesdeclaration( false ) end? 
if sy = labelsy then 

3EGIN 

IF INMODULE AND ININTERFACE THEN 

BEGIN ERROR(186)5 SKIP(FSYS - CLABELSY]) END 
ELSE INSYMBOL; LABELDECLARATION END; 
IF SY = CONSTSY THEN 

BEGIN INSYMBOL? CONSTDECLARATION END; 
IF SY = TYPESY THEN 

3EGIN INSYM80L5 TYPEDECLARATION END; 
IF SY = VARSY THEN 

3EGIN insymbol; vaRdeclaration end; 

IF LEVEL = 1 THEN GLEV := TOP; 

IF SY IN CPROCSY»FUNCSY,PROGSY] THEN 



1964 12 1:3 84 BEGIN 

i9o5 12 1:4 84 IF INMODULE THEN 

1966 12 1:5 38 IF rjINTEKFACE AND MOT USING THEN PUBLICPROCS := TRUE; 

1967 12 i:4 99 REPEAT 

1968 12 lib 99 LSY := SY5 INSYMBOL; 

1969 12 1:5 J5 IF LSY = PROGSY THEM 

1970 12 1:6 10 IF INMODULE THEN 

1Q70 \\ 1:1 14 BEGIN ElRROR(185 (*SEG DEC NOT ALLOWED IN UNIT*)); 

.„, l * 1:a 20 PROCDECLARATIONCPROCSY, FALSE) 

i973 12 1:7 22 END 

1974 12 i:6 24 ELSE PROCDECLARATION ( LSY .TRUE) 

1975 12 1:5 28 ELSE PROCDECLARATION ( LSY . FALSE) 5 

1976 12 1:4 36 UNTIL NOT (SY IN CPROCSY . FUNCSY. PROGSY}) 

1977 12 1:3 48 EN D; 

1978 12 1:2 51 IF (SY <> BEGINSY) THEN 

J'oln 12 1I3 56 lF N0T << USIN S OR INMODULE) AND (SY IN C IMPLESY.ENDSY3) ) 

1980 12 i:3 75 AND NOT( SY IN CSEPARATSY,UNITSY3) THEN 

1981 12 i:«* 94 if (NOT (INCLUDING OR NOTDONE)) 

1982 12 1:4 99 OR 

1 oo 3 12 1!<f " NOT(SY IN BLOCKBEGSYS) THEN 

JJ! \\ Ji^ \l BEGIN ERRORdS); SKIP(FSYS - CUNITSY, INTERSY3) ; END J 

.III Jo 1#1 37 UNTlL (SY IN <STATBEGSYS + CSEPARATSY.UNITSY, IMPLESY.ENDSYD) ) ; 

1986 12 1:1 59 NEWBLOCK:=FALSE; 

1987 12 1:0 62 END ( *OECLARATIONPART*) J 

1988 12 i;o 78 

1989 12 i:o 78 

1990 12 HO 78 (*$I #5:0ECPART.C.TEXT*) 

1990 12 i:o 78 (*$I H5:30DYPART.A.TEXT*) 

1991 12 1:0 78 

1992 12 i:o 78 (* COPYRIGHT (C) 1979» REGENTS OF THE *) 

1993 12 HO 78 (* UNIVERSITY OF CALIFORNIA. SAN DIEGO *) 

1994 12 HO 78 

1995 13 i:d 1 SEGMENT PROCEDURE BODYPART ( FSYS: SETOFSYS; FPROCP: CTP); 

1996 13 1ID 6 

1997 13 2!D 1 PROCEDURE LINKERREF ( KLASS: IDCLASS; ID.ADDR: INTEGER); 

1998 13 2:0 BEGIN 

1999 13 2:i IF NREFS > REFSPERBLK THEN (*WRITE BUFFER*) 

2000 13 2:2 9 BEGIN 



2001 13 2:3 9 



2002 13 2:3 36 REFBLK := REFBLK + 1; 

2003 13 2:3 44 nreFS := 1 



IF BLOCKlAfRITEtREFFILE.REFLIST^.l, REFBLK) <> 1 THEN ERROR(402)» 
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ElMj; 
WITH REFLIST^CNREFS] DO 

BEGIN 

IF klass in vaks then key := ID + 32 

ELSE (*PRGC*) KEY := ID; 
OFFSET := SEGINX + ADDR 
END! 
NREFS := NREFS + 1 
END (*LINKERREF*) ; 

PROCEDURE G.EN0(FOP: OPRaNGE); 

var 1: integer; oddic: boolean; 

BEGIN 

IF FOP <> 38(*LCA*> THEN GENBYTE(F0P+128) 
ELSE 
BEGIN 

ODDIC 1= ODD(IC); strgcstic := ic; 
IF NOT ODDIC THEN GENBYTE(215(*N0P*)) ; 
GENBYTE(166(*LCA*)); 
WITH GATTR.CVAL.VALP~ DO 
BEGIN GENBYTE(SLGTH) ; 

FOR I := 1 TO SLGTH DO GENBYTE ( ORDCSVALC I 1) ) ; 
IF ODDIC THEN GENBYTE ( 215 ( *NOP* ) ) 
END 
END 
END (*GEN0*) ; 

PROCEDURE GENLDCdvAL: INTEGER); 

BEGIN 

IF (IyAL >= 0) AND (IVAL <= 127) THEN GENBYTE ( IVAL ) 

ELSE 

BEGIN GENBYTE(51(*LDC*)+118) ! 
GENBYTEt ABS(IVAL) MOD 256 ); 
GENBYTEt ABS(IVAL) DlV 256 ); 
IF IVAL<0 THEN GENO ( 17 ( *NGI*) ) 
END 
END (*GENLDC*) 5 

PROCEDURE GENBIGdVAL: INTEGER); 
BEGIN 

IF IVAL <= 127 THEN GENBYTE ( IVAL ) 



O »*f s~+ 

3 /b 



^045 13 5:i & r LSE 

2046 13 5:2 11 BEGIN 

till \\ V-l \\ 5ENBYTE( 128 + <IVAL DIV 256) ); 

pi \t l\l 2 l GEMBYTEt IVAL MOD 256 ) 

2050 13 b:o 31 END <*GENBIG*) ; 

i051 13 5:o 44 

2053 \\ V-n J PROCEDURE GENKFOP; OPRANGE; FP2: INTEGER) 

' U3 ° 11 6JD 3 LABEL 1; 

Hit }l 6:D 3 VAR I' J: INTEGER; 

2055 13 6:0 BEGIN 

Inly H f' 1 ° GENBYTE(F0P + 128); 

loll 11 i\i 13 8 if be f g v 5i <* ldc *> ™ en 

till » t\l i 8 3 Z/™ - 2 ™ EN * : = RE ^SIZE 

2 ?!J H &;/+ 23 BEGIN I : = 8 ? 

2062 13 6:5 26 



2063 n c. t ,, WHILE ! > DO 

2064 « t:1 11 IF GATTR.CVAL.VALP-.CSTVALCI3 <> THEN GOTO 1 

20 6 5 13 6:5 55 1S END; *~ " 

2^67 J? fix *o GATTR.TYPTR-.SIZE .= I; 

«*u&7 13 6.3 58 IF I > 1 THEN 

2069 II V-t !? BEGIN SENBYTE(I); 

2070 13 til 87 E / D ° R J := l D0WNT ° X D0 GENWORDI6ATTR.CVAL.VALP-.CSTVALCJ3) 

2071 13 6:3 97 EL SE 

IVfl 11 V.i " begin IC : = IC - 1* 

2074 13 £|* Js enJ F * = * ™ EN GENLDC(GATTR - CVAL -VALP«.CSTVALC13, 

2075 13 6:2 20 END 

2076 13 6:1 20 ELSE 

2078* II V-t II IF F ° P IN "0(*CSP*),32(*ADJ*),45(«RNP*), 

2079 13 6-p 11 *6<*CIP*).60C*LDM*),61(»STH»), 

2080 13 t'l II 65(*RBP*),66(*CBP*),78(*CLP*), 

2081 13 t\l 11 ELSE ^(*SAS*),79(*CGP*)3 THEN GENBYTE(FP2) 

POfl 2 ; \\ V-n ?f IF lNM ODULE AND (FOP IN C37 ( *LAO*) , 41 ( *LDO* ) ,43 ( *SRO») 1) THFW 

loll 11 t':t " r JKIN LINK E RREFCACTUALVARS.FP2.ic)t C G C SSYTn?M?? ;^^ END 



2085 13 6:4 80 EL fp ((FOP = 



74(*LDL*)) OR (FOP = 41(*LD0*))) 
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AND (FP2 <= 16) THEN 

BEGIN ic := ic-i; 

IF FOP = 41(*LD0*) THEN GENBYTE ( 231+FP2 ) 
ELSE GENBYTE(215+FP2) 
END 
ELSE 

IF (FOP = 35(*IND*)) AND (FP2 <= 7) THEN 
BEGIN iC := iC-i; GENBYTE(248+FP2) END 
ELSE 

GENBIG(FP2) 
END (*GEN1*) J 

PROCEDURE GEN2(F0P: OPRaNGE? FPltFP2: INTEGER); 
BEGIN 

IF (FOP = 64(*IXP*)) OR (FOP = 77(*CXP*)) THEN 

BEGIN GENBYTE(F0P+128)! GENBYTE (FPl ) ; GENBYTE (FP2 ) ; 
END 
ELSE 

IF FOP IN C47(*EQU*)»48(*GEQ*) i49(*GRT*)f 

52(*LEQ*)«53(*LES*).55(*NEO*)3 THEN 
IF FPl = THEN GEN0(FOP+20) 
ELSE 

BEGIN GEN1(F0P,FP1+FP1) ! 

IF FPl > 4 THEN GEN3IG(FP2) 
END 
ELSE 

BEGIN (*LDAtLOD.STR*) 

IF FPl = THEN GENl(FOP+20tFP2) 
ELSE 
BEGIN 

GENBYTE(P0P+128) 5 GENBYTE ( FPl ) ! GENBIG(FP2) 
END 

END; 

END (*GEN2*) 5 

PROCEDURE GENNR(EXTPROC: NONRESIDENT) J 

PROCEDURE ASSIGN(EXTPR0C: NONRESIDENT); 
BEGIN 

PROCTABLECNEXTPROCJ := 0; 

PFNUMOFCEXTPROC3 := NEXTPROC; NEXTPROC := NEXTPROC + 1; 
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c[i"kERINFO >-^*!™ M THEN E*R0R(193>;<*N0T ENOUGH ROOM FOR THIS*, 
tm <*ASSI3I\I*>"; ("OPERATION*) 

BEGIN (*GENNR*) 

IF PFNUMOFCEXTPROCH = THEN ASSIGN (EXTPROC ) ; 
IF SEPPROC THEN 
BEGIN 

^GENK79(*CGP*),0>; LINKERREF ( PRO C , -PFNUMOFC EXTPROC 3, IC-1 ) 

ELSE 

GlN1(79(*CGP*, , PFNUMOFCEXTPROCH) 5 
END (+GENNR*) ; 

PROCEDURE GENJMP(FOP: OPRANGE; flbp: LBP); 

var disp: integer; 

BEGIN 

WITH FLBP'" DO 

IF DEFINED THEN 
BEGIN 

GENBYTE(FOP+128) i 
DISP := OCCURIC-IC-I! 

ELSE° ISP >= ^ AN ° <DISP <= 127) THEN GENB YTE(DISP, 
BEGIN 

IF JTABINX = THEN 

BEGIN JTABINX := NEXTJTAB; 

IF NEXTJTAB = MAXJTAB THEN ERR0R<253) 
ELSE NEXTJTAB := NEXTJTAB + 1! 
JTABCJTABINX3 := OCCURlC 
END; 

DISP := -JTABINX? 

GENBYTEt 248- JTABINX- JTABINX) 

end; 

END 
ELSE 

3EGIN M0VELEFT(REFLIST.C0DEP^CIC1,2) ; 

IF FOP = 57<*UJP*) THEN DISP := IC + 4096 

ELSE DISP := IC; 

REFLIST := DISP; IC := ic+2 

end; 
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END (♦GENJMP*) ; 
PROCEDURE LOAD! FORWARD; 

procedure genfjp<flbp: LBP); 
begin load; 

if gattr.typtr <> boolptr then err0r(135); 

genjmp(33(*fjp*) ,flbp) 
end (*genfjp*) ; 

procedure genlabel(var flbp: lbp); 
begin new(flbp) 5 
with flbp~ do 
begin defined ;= false; reflist := maxaddr end 
end (*genlabel*) ; 

procedure putlabel(flbp: lbp); 
var lref: integer; lop: oprange; 

BEGIN 

WITH FLBP* DO 

BEGIN LREF := REFLIST; 

defined := true; occuric := ic; jtabinx := o; 

WHILE LREF < MAXADDR DO 
BEGIN 

IF LREF >= f096 THEN 

BEGIN LREF := LREF - 4096; LOP := 57(*UJP*) END 
ELSE LOP := 33(*FJP*) ; 

ic := lref; 

MOVELEFT(CODEP A i:lC3tLREF»2) ! 
GENJMP(LOP'FLBP) 

end; 
ic := occuric 

END 

end (+pjtlabel*) ; 

procedure load; 
var j,m: integer; 

BEGIN 

WITH GATTR DO 

IF TYPTR <> NIL THEN 

3EGIN 
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CASL kind of 
cst: if typtr^.form = longint then 
with gattr.cval.vai_p~ do 

BEGIN 

m := 10000; 

GENLDC(LONGVALCID); GENLDC ( 18( *DCVT* ) ) J GENNR (DECOPS ) 
FOR J := 2 TO LLENG DO 
BEGIN 

IF J = LLENG THEN M := TRUNC (PWROFTEN(LLAST) ) ! 

GEMLDC(M); GENLDC(18(*DCVT*)); GENNR(DECOPS) ! 

GEMLDC(8{*DMP*)) ; GENNR ( DECOPS) ; 

GENLDC(LONGVALCJ3) ; 

GENLDC(18(*DCVT*))5 GENNR (DECOPS) { 

GENL0C(2<*DAD*>); GENNR (DECOPS) 
END 



AND (TYPTR <> REALPTR) THEN 



varbl: 



END 
ELSE 

IF (TYPTR^.FORM = SCALAR) 

GENLDC(CVAL.IVAL) 
ELSE 

IF TYPTR = NILPTR THEN GENO (31 ( *LDCN* ) ) 
ELSE 

IF TYPTR = REALPTR THEN GENl (51 (*LDC*) «2 ) 
ELSE GEN1(51(*LDC*) t5)5 
CASE ACCESS OF 



expr: 

end; 

WITH 
IF 



drct: 

indrct: 

packd: 

multi: 

BYTE: 

end; 



IF VLEVEL = 1 THEN GENl (41 (*LDO*) .DPLMT ) 

ELSE GEN2(54(*L0D*) tLEVEL-VLEVEL, DPLMT) ; 

GEN1(35(*IND*)»IDPLMT) ; 

GEN0(58(*LDP*) ) ; 

GENl ( 60 (*LDM*) tTYPTR*. SIZE) ; 

GEN0(62(*LD3*) ) 



END 



KIND 
END 
(*LOAD*) 



TYPTR-* DO 

( (FORM = POWER) OR 

(FORM = LONGINT) AND (KIND <> CST)) 

AND (KIND <> EXPR) THEN GENLDC ( TYPTR*. SIZE) ? 

:= EXPR 
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3C2 

2250 13 11 :o 38 

2251 13 15: D 1 PROCEDURE STORE(VAR FATTR: ATTR); 

2252 13 15:o BEGIN 

2253 13 15:i wlITH FATTR DO 

2254 13 1512 3 IF TYPTR <> NIL THEN 

2255 13 15:3 9 CASE ACCESS OF 

2256 13 15:3 13 DRCT: IF VLEVEL = 1 THEN GENl ( <f3< *SR0*) t DPLMT ) 

2257 13 15:* 22 ELSE GEN2 < 56 < *STR* ). LEVEL-VLEVEL .DPLMT ) ; 

2258 13 15:3 38 INDRCT: IF IDPLMT <> THEN ERROR<400) 

2259 13 15:4 47 ELSE GENO ( 26 ( *ST0*) ) 5 

2260 13 15:3 57 PACKD: GENO ( 59 ( *STP* ) ) ; 

2261 13 15:3 62 MULTI.* GENl < 61 ( *STM*) . TYPTR*. SIZE > 5 

2262 13 15:3 70 BYTE: GENO ( 63 ( *ST8* ) ) 

2263 13 15:3 71 END 

2264 13 15:0 92 END (*STORE*) J 

2265 13 15:0 04 

2266 13 16:D 1 PROCEDURE LOADADDRESSi 

2267 13 16:0 BEGIN 

2268 13 16:i WITH GATTR DO 

2269 13 16J2 IF TYPTR <> NIL THEN 

2270 13 16:3 5 BEGIN 

2271 13 16:4 5 CASE KIND OF 

2272 13 16:4 8 CST: IF STRGTYPEC TYPTR ) THEN GENO ( 38 (*LCA* ) ) 

2273 13 16:5 17 ELSE ERROR(400); 

2274 13 16:4 29 VARBL: CASE ACCESS OF 

2275 13 16:5 32 DRCT: IF VLEVEL = 1 THEN GENl < 37<*LA0* ) .DPLMT) 

2276 13 16:6 39 ELSE GEN2 ( 50 ( *LDA* ). LEVEL-VLEVEL. DPLMT ) } 

2277 13 16:5 53 INDRCT: IF IDPLMT <> THEN GENl (34 ( *INC* ). IDPLMT); 

2278 13 16:5 64 PACKD: ERRORU03) 

2279 13 16:5 65 END 

2280 13 16:4 84 END; 

2281 13 16:4 98 KIND := VARBL; ACCESS := INDRCT; IDPLMT := 

2282 13 16:3 04 EN D 

2283 13 16:0 07 END ( *LOADADDRESS* ) ; 

2284 13 16:0 20 

2285 13 17!D 1 PROCEDURE BYTEADDRESS; 

2286 13 17!0 BEGIN 

2287 13 1711 WITH GATTR DO 

2288 13 17:2 IF TYPTR <> NIL THEN 

2289 13 17:3 5 3EGIN 

2290 13 17:4 5 CASE KIND QF 



?292 H w* A CST: IF ST «GTYPL(TYPTR) THEN GENO ( 38 ( *LCA* ) ) 

„ t? },:, II E ^ E ERROR<400); 

~294 13 17-*s -I VAR3L: CASL ACCESS OF 

2295 13 17 : 6 39 ° RCT: IF VLEVEL = X THEN GEN1 ( 37 < ♦LAO* ) , DPLMT ) 

2296 13 17-? H ELSE GEN2(5 0(*LDA*),LEVEL-VLEVEL,DPLMT){ 

2297 13 17-5 64 l^ RCT '' IF IDPLMT ° ° ™ EN GENl ( 34 < *INC^ > , IDPLMT ) ; 

pp9a iJ {: s *Z packd: errorqo3) 

2298 13 1755 65 F ,,n 

2299 13 1714 84 END; ^ 

23cS " 17.-4 09 ELSE IN ° <> VARBL ^^ BEGIN "^ S = VARBL ' GENLDC ( ° > END 

2303 13 IT- 1 ? fi IF ACCESS <> BYTE THEN GENLDC(O) I 

2304 13 17.-3 22 END '" 

?*2? J! P :0 22 END <*3YTEADDRESS*) ; 

2306 13 17:0 34 



2307 13 18:D 1 



PROCEDURE STRGTOPA(FIC: ADDRRANGE)! 



2308 13 18:o BEGIN 

?f?n H IV. 1 ° IF ODD(FIC) THEN 

2310 13 1812 3 3EG IN 

2312 11 IV. I 9 l MOVERIGHT( CODEP*CFlC + i:i, CODEP*CFIC+23i ORDCCODEP*CFIC+13)+l ){ 

lilt 13 it'll 33 COOEP-CFIC3 := CHR (215 ( *NOP* ) ) , CODEP^FIC + ID % CHR (268 ( ijpj. ! ) 

2314 13 18:i 34 EL se; 

2315 13 18:2 36 BEGIN 

2317 11 H*l It MOVELEFTf CODEP*CFIC+23, CODEP-CFIC+13, 0RDCC0DEP*CFIC+23>*1 ); 

2318 II H\l 5 7 l EH o ZF1C1 ^ CHR(208,J COOEP^FIC + ORDCCODEP*CFIC*l5»+23 := CHR(215, 

2319 13 18:o 73 END (*STRGTOPA+) ; 

2320 13 18:o 86 

2321 13 1910 1 

2322 13 19:d 5 

2323 13 20:d 1 

2325 » 20°.-0 BEG^N LATTR: ATTR? LCP: CTP < ^LMAxi INTEGER; 

Illy H Inl 1 ° WITH fCP "' GATTR 0° 

till H In'.- ,« 8E&IN TYPTR := I U TYPE5 KINO : = VARBL? 

5J5« °* 3 10 CASE KLASS OF 

llll H I '' 5 15 ACTUALVARS: 

233? II ll\t It BE ?f N inSul L e : ; h eT V5 DPLMT := VADDR; ACCESS := DRCT < 



PROCEDURE EXPRESSI0N(FSYS: SETOFSYS); FORWARD; 
PROCEDURE SELECTOR(FSYS: SETOFSYS; FCP: CTP) ; 
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334 

if typtr <> nil then 
if (vlev = 1) and ( typtr" .form = records) then loadaddress 

end; 
formalvars: 

BEGIN 

IF VLEV = 1 THEN GEN1 ( 41 ( *LDO* ) , VADDR ) 
ELSE 3EN2(54(*L0D*) , LEVEL-VLEV* VADDR ) ; 

access := indrct; ioplmt := o 
end ; 
field: 
with displaycdisx: do 

BEGIN 

if occur = crec then 
begin access := drct; vlevel := clev; 
dplmt := cdspl + fldaddr 

END 
ELSE 

begin 

IF LEVEL = 1 THEN GENl(4l(*LD0*)fVDSPL) 

else gen2(54(*l0d*)»0,vdspl) 5 

access := indrct; idplmt := fldaddr 
END; 
IF FISPACKD THEN 
BEGIN LOADADDRESS; 

ACCESS := PACKO! 

GENLDC(FLDWIDTH) ! GENLDC (FLDRBIT) 
END 

end; 
func: 

IF PFDECKIND <> DECLARED THEN ERRORU50) 
ELSE 

IF NOT INSCOPE THEN ERROR(103) 
ELSE 

BEGIN ACCESS := DRCT5 VLEVEL := PFLEV + 1; 
DPLMT := LCAFTERMARKSTACK 

ENC 
END (*CASE*); 
IF TYPTR <> NIL THEN 

IF (TYPTR A .FORM <= POWER) AND 
(TYPTR*, SIZE > PTRSIZE) THEN 
BEGIN LOADADDRESS; ACCESS != MULTI END 
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EN j <*WITH*); 
IF NOT (SY 1'4 SELECTSYS + FSYS) THEN 

BEGIN ERR0R(59); SKIP ( SELECTSYS + FSYS) END? 
WHILE SY IN SELECTSYS DO 
BEGIN 
(*C*) IF SY = LBRACK THEN 
BEGIN 

REPEAT LATTR := GATTR; 
WITH LATTR DO 

IF TYPTR <> NIL THEN 

IF TYPTR*. FORM <> ARRAYS THEN 

BEGIN ERR0RQ38); TYPTR Is NIL END; 
LOADADDRESS; 

INSYMBOL; EXPRESSION(FSYS + CCOMMA,RBRACK3) ; 
LOAD; 
IF GATTR. TYPTR <> NIL THEN 

IF GATTR. TYPTR*. FORM <> SCALAR THEN ERR0R<113); 
IF LATTR. TYPTR <> NIL THEN 
WITH LATTR. TYPTR* DO 
BEGIN 

IF COMPTYPESdNXTYPE, GATTR. TYPTR) THEN 
BEGIN 

IF (INXTYPE <> NIL) AND 

NOT STRGTYPE(LATTR. TYPTR) THEN 
BEGIN GETBOUNDS(INXTYPEtLMINtLMAX) J 
IF RANGECHECK THEN 

BEGIN GENLDC(LMIN); GENLDC (LMAX) 5 

GEN0(8(*CHK*)) 
END; 
IF LMIN <> THEN 

BEGIN GENLDC(ABS(LMIN)); 

IF LMIN > THEN GENO (21 (*SBI* ) ) 
ELSE GEN0(2<*ADI*>) 
END 
END 
END 
ELSE ERR0RU39) ; 
WITH GATTR DO 

BEGIN TYPTR := AELTYPE; KIND := VARBL; 
ACCESS := INDRCT; IDPLMT := 0; 
IF TYPTR <> NIL THEN 



385 






2414 


13 


20:2 


67 


2415 


13 


20:3 


71 


2416 


13 


20:4 


77 


2417 


13 


20:5 


80 


2418 


13 


20:6 


91 


2419 


13 


20:5 


92 


2420 


13 


20:4 


96 


2421 


13 


20:3 


96 


2422 


13 


20:4 


98 


2423 


13 


20:5 


01 


2424 


13 


20:4 


06 


2425 


13 


20:2 


08 


2426 


13 


20:3 


10 


2427 


13 


20:4 


15 


2428 


13 


20:4 


19 


2429 


13 


20:5 


26 


2430 


13 


20:3 


26 


2431 


13 


20:0 


29 


2432 


13 


20:8 


29 


2433 


13 


2o;5 


29 


2434 


13 


20:5 


34 


2435 


13 


20:4 


45 


2436 


13 


20:3 


48 


2437 


13 


20:4 


50 


2438 


13 


20:5 


55 


2439 


13 


20:6 


55 


2440 


13 


20;7 


55 


2441 


13 


20:8 


55 


2442 


13 


20:9 


60 


2443 


13 


20:0 


66 


2444 


13 


20:8 


75 


2445 


13 


20:8 


78 


2446 


13 


20:9 


83 


2447 


13 


20:0 


83 


2448 


13 


20:1 


88 


2449 


13 


20:2 


95 


2450 


13 


20:3 


00 


2451 


13 


20:2 


09 


2452 


13 


20:3 


11 


2453 


13 


20:4 


14 


2454 


13 


20:5 


18 



IF AISPACKO THEN 

IF ELkJIDTH = 8 THEN 

BEGIN ACCESS := BYTE; 

IF STRGTYPE(LATTR.TYPTR) AND rangecheck 

GEN0(27(*IXS*) ) 
ELSE (*LEAVE BASE-INDEX PAIR*) 
EMD 
ELSE 

BEGIN ACCESS := PACKD; 

GEN2(64(*IXP*),ELSPERWDiELWIDTH) 
END 
ELSE 

BEGIN GEN1 ( 36 (*IXA*)» TYPTR*. SIZE) ; 
IF (TYPTR*. FORM <= POWER) AND 
(TYPTR^.SIZE > PTRSIZE) THEN 
ACCESS := MULTI 
END 
END 

END 
UNTIL SY <> COMMA; 

IF SY = RBRACK THEN INSYMBOL ELSE ERR0RQ2) 
END <*IF SY = LBRACK*) 
ELSE 
(*.*) IF SY = PERIOD THEN 
BEGIN 

WITH GflTTR DO 
BEGIN 

IF TYPTR <> NIL THEN 

IF TYPTR~.FORM <> RECORDS THEN 

BEGIN ERRORU40); TYPTR := NIL ENDl 
INSYMBOL; 

IF SY = IDENT THEN 
BEGIN 

IF TYPTR <> NIL THEN 

BEGIN SEARCHSECTlON<TYPTR*.FSTFLD,LCP) ! 
IF LCP = NIL THEN 

BEGIN ERR0RU52)} TYPTR := NIL END 
ELSE 

WITH LCP A DO 

BEGIN TYPTR := IDTYPE; 
CASE ACCESS OF 
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drct: oplmt := dplmt + fldaddr; 

INDRCT; IDPLMT := IDPLMT + FLDADDR; 
MULTIt3YTEi 

packd: erroruoo) 
end <*case access*) 5 
if fispackd then 

BEGIN LOADADDRESS; 

ACCESS := PACKD; 

GENLDC(FLDWIDTH) 

END! 

IF TYPTR <> NIL THEN 

IF (TYpTR~.FORM <= POWER) AND 
(TYPTR' 4 . SIZE > PTRSIZE) THEN 
BEGIN LOADADDRESS; ACCESS := MULTI END 



GENLDC(FLDRBIT) 



END 
END; 
INSYMBOL 
END (*SY = IDENT*) 
ELSE ERR0R(2) 
END (*WITH GATTR*) 
END (*IF SY = PERIOD*) 
ELSE 
(*~*) BEGIN 

IF GATTR. TYPTR <> NIL THEN 
WITH GATTR,TYPTR~ DO 

IF (FORM = POINTER) OR (FORM = FILES) THEN 
BEGIN LOAD; KIND .*= VARBL; 

ACCESS := INDRCT? IDPLMT := 0; 

IF FORM = POINTER THEN TYPTR := ELTYPE 

ELSE 

BEGIN TYPTR := FILTYPE? 

IF TYPTR = NIL THEN ERR0R(399) 
END; 
IF TYPTR <> NIL THEN 

IF (TYPTR*. FORM <= POWER) AND 
(TYPTR*. SIZE 
ACCESS 
END 

ELSE ERR0RU41) ; 
INSYMBOL 

end; 



> PTRSIZE) 
!= MULTI 



THEN 
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2496 13 20:3 03 IF NOT (SY IN FSYS + SELECTSYS) THEN 

2497 13 20:4 19 BEGIN ERR0R(6); SKIP(FSYS + SELECTSYS) END 

2498 13 20:2 39 END (*WHILE*) 

2499 13 20:0 39 END ( *SELECTOR* ) ; 

2500 13 20:0 72 

2501 13 20:0 72 <*$I tt5:30QYPART.A,TEXT*) 

2501 13 20:0 72 (*$I #5:BODYPART.B.TEXT*) 

2502 13 20:0 72 

2503 13 20:0 72 (* COPYRIGHT (C) l979i REGENTS OF THE *) 

2504 13 20:0 72 (* UNIVERSITY OF CALIFORNIA* SAN DIEGO *) 

2505 13 20:0 72 

2506 13 2i:D 1 PROCEDURE CALL(FSYS: SETOFSYS; FCPt CTP); 

2507 13 2i:0 6 VAR LKEY: 1..43; WASLPARENT: BOOLEAN; 

2508 13 2i:D 8 

2509 13 22!D 1 PROCEDURE VARIABLE (FSYS: SETOFSYS); 

2510 13 22:D 5 VAR LCP: CTPJ 

2511 13 22:0 BEGIN 

2512 13 22U IF SY = IDENT THEN 

2513 13 22:2 5 BEGIN SEARCHlD(VARS+CFIELD3iLCP) ; INSYMBOLEND 

2514 13 22:i 21 ELSE BEGIN ERRoR(2>; LCP := UVARPTR END; 

2515 13 22:i 31 SELECTOR(FSYS.LCP) 

2516 13 22:o 39 END (*VARIABLE*) ; 

2517 13 22:0 54 

2518 13 23:D 1 PROCEDURE STRGVAR (FSYS: SETOFSYS! MUSTBEVAR: BOOLEAN): 

2519 13 23:0 BEGIN EXPRESSION (FSYS) ; 

2520 13 23:i 9 WITH GATTR DO 

2521 13 2312 9 IF ((KIND = CST) AND (TYPTR = CHARPTR)) 

2522 13 23:2 17 OR STRGTYPE ( TYPTR ) THEN 

2523 13 23:3 26 IF KIND = VARBL THEN LOADADDRESS 

2524 13 23!3 31 ELSE 

2525 13 23:4 35 BEGIN 

2526 13 23:5 35 IF MUSTBEVAR THEN ERR0RU54)! 

2527 13 2315 44 IF KIND = CST THEN 

2528 13 23:6 49 BEGIN 

2529 13 23:7 49 IF TYPTR = CHARPTR THEN 

2530 13 23:8 55 BEGIN 

2531 13 23:9 55 WITH SCONST* DO 

2532 13 23:0 59 BEGIN CCLASS := STRG! SLGTH := 1; 

2533 13 23:i 67 SVALCID := CHR < CVAL. IVAL) 

2534 13 23:0 74 END; 

2535 13 23:9 75 CVAL.VALP := SCONST; 
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23.*4 
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25.* d 
25 :d 
25:d 
2510 

25:1 
25:1 
25:2 
25:3 

25:4 

25:5 

25:6 

25:7 

25:8 

25:7 
25:4 
25:3 
25:1 
25:2 
25:3 

25.*3 
25:3 
25.'3 

25:4 
2514 



79 

84 

S9 

92 

94 

94 

96 

96 

98 

98 

07 

07 

11 

24 

1 

2 

1 

1 

1 

6 



15 

24 

29 

32 

38 

38 

44 

48 

52 

58 

62 

62 

68 

73 

76 

94 

99 

07 

12 
21 



NEW(TYPTR, ARRAYS, TRUE, TRUE) ; 
TYPTR* := STRGPTR~; 

TYPTR*.WAXLENG := 1 
END; 

LOADADDRESS 

END 

END 

ELSE 

BEGIN 

IF GATTR.TYPTR <> NIL THEN ERR0RU25); 
GATTR.TYPTR := STRGPTR 
ENO 
END <*STRGVAR*) j 

PROCEDURE ROUTINE (LKEY: INTEGER); 

PROCEDURE NEWSTMTl 

LABEL l; 

VAR LSP,LSPl; STP; VARTS.LMIN.LMAXI INTEGER; 
LSIZEiLSZ: ADDRRANGE; LVAH VALU; 
BEGIN VARIABLE(FSYS + CCOMMAiRPARENTD) J LO A DADDRESS« 

lsp := nil; varts := o; lsize := o; 

IF GATTR.TYPTR <> NIL THEN 
WITH GATTR.TYPTR* DO 
IF FORM = POINTER THEN 
BEGIN 

IF ELTYPE <> NIL THEN 
WITH ELTYPE* DO 

BEGIN LSIZE := SIZE; 

IF FORM = RECORDS THEN LSP := RECVAR 

END 
ELSE ERR0R(116) J 
WHILE SY = COMMA DO 
BEGIN INSYMBOL; 

CONSTANT(FSYS + CCOMMA, RPARENTDtLSPl ,LVAL) ; 

VARTS := VARTS + 1* 

IF LSP = NIL THEN ERR0R(158) 

ELSE 

IF LSP*. FORM <> TAGFLD THEN ERR0RC162) 
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13 


2594 


13 


25:1 


15 


2595 
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IF LSP'.TAGFIELDP <> NIL THEN 

IF STRGTYPEUSP1) OR (L.SP1 = REALPTR) THEN ERR0RU59) 

ELSE 

IF C0MPTYPES(LSP' N .TAGFIELDP'VIDTYPE,LSP1) THEN 

BEGIN 

LSP1 := LSP^.FSTVARi 
WHILE LSP1 <> NIL DO 
WITH LSP1* DO 

IF V/ARVAL.IVAL = LVAL.IVAL THEN 

BEGIN LSIZE := SIZE! LSP := SUBVAR; 

GOTO 1 
END 

else lsp1 := nxtvar5 
lsize := lsp". size; lsp := nil; 

END 
ELSE ERR0RU16) ; 
i: END (*WHILE*> ? 

genldc(lsize) ; 
gen1(30(*csp*) »1(*new*) ) 
end <*newstmt*) ; 

procedure move} 

BEGIN VARIABLE(FSYS + CCOMMA3) ; BYTEADDRESS; 
IF SY = COMMA THEN INSYMBOL ELSE ERROR(20); 
IF LKEY s 27 THEN 

BEGIN EXPRESSIONtFSYS + CCOMMA3M LOAD END 

ELSE 

BEGIN VARIABLE(FSYS + CCOMMA3)} BYTEADDRESS END» 
IF SY = COMMA THEN INSYMBOL ELSE ERROR<20>5 
EXPRESSIONtFSYS + CRPARENT3)J LOAD; 
IF LKEY = 27 THEN GENK 30 ( *CSP* ) ♦ 10 ( *FLC*) ) 
ELSE 

IF LKEY = 21 THEN GEN1 ( 30 ( *CSP* ) . 2 ( *MVL* ) ) 

ELSE GEN1(30«*CSP*) f 3(*MVR*) ) 
END (*MOVE*) 5 

PROCEDURE EXIT; 

VAR lcp: CTP; 
BEGIN 

IF SY = IDENT THEN 

BEGIN SEARCHID(CPROC»FUNC3iLCP); INSYMBOL END 
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41 
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14 
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ELSE 

IF (SY = PROGSY) THEN 

BEGIN LCP := OUTERBLOCK; INSYMBOL end 
ELSE LCP := NIL? 
IF LCP <> NIL THEN 

IF LCP".PFDECKIND = DECLARED THEN 

BEGIN GENLDCaCP^.PFSEG) ; GENLDC ( LCP^.PFNAME ) ; 
IF INMODULE THEN 

BEGIN LINKERREF(PR0C.LCP«.PFSEG»IC-2) ; 

IF SEPPROC THEN LINKERREF (PROC, -LCP^.PFNAMEt IC-1 ) ; 
END 
END 
ELSE ERR0R<125) 
ELSE ERR0R(125); 
GEN1(30(*CSP*) i4(*XIT*) ) 
END <*EXIT*> ; 

PROCEDURE UNITIOJ 
BEGIN 

IF GATTR.TYPTR <> INTPTR THEN ERRORU25)? 
IF SY = COMMA THEN INSYMBOL ELSE ERROR(2Q)5 
VARIABLE(FSYS ♦ CCOMMAU) 5 BYTEADDRESS? 
IF SY = COMMA THEN INSYMBOL ELSE ERROR(20); 
EXPRESSION(FSYS + CCOMMA, RPARENTD) J LOAD? 
IF GATTR.TYPTR <> INTPTR THEN ERR0RU25); 
IF SY = COMMA THEN 
BEGIN INSYMBOL; 

IF SY = COMMA THEN GENLDC(O) 
ELSE 
BEGIN 

EXPRESSION(FSYS + CCOMMA.RPARENT3) 5 LOAD? 
IF GATTR.TYPTR <> INTPTR THEN ERR0RQ25) 
END 
END 
ELSE GENLDC(0>5 
IF SY = COMMA THEN 
BEGIN INSYMBOL; 

EXPRESSI0N<FSYS + 
IF GATTR.TYPTR <> 
END 
ELSE GENLDC (0) ! 



CRPARENT3) ; 
INTPTR THEN 



load; 

ERR0RU25) 
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IF LKEY = 13 THEN GENl ( 30 ( *CSP*) . 5 ( *UR0* ) ) 
ELSE GEN1(30(*CSP») ,6(*UWT*) ) 
END (*UNITIO*); 



TEMPLGTH: INTEGER: 



procedure cowcat5 

var llc: addprange; 
begin templgth := 0; 

llc := lc; lc := lc + (STRGlgth oiv chrsperwd) + l; 

GENLQC(O) J GEN2(56(*STR*)iO,LLC) ; 

GEN2(50(*LDA*) tO.LLC) ; 

REPEAT 

STRGVAR(FSYS + CC0MMA,RPARENTD, FALSE) 5 

TEMPLGTH := TEMPLGTH + GATTR.TYPTR*,MAXLENG $ 

IF TEMPLGTH < STRGLGTH THEN GENLDC ( TEMPLGTH) 

ELSE GENLDC(STRGLGTH); 

GEN2(77(*CXP*)«0(*SYS*) »23( *SCONCAT*) ) ; 

GEN2(50(*LDA*) iO»LLC); 

TEST := SY <> COMMA; 

IF NOT TEST THEN INSYMBOL 
UNTIL TEST! 
IF TEMPLGTH < 

LC := LLC + 
ELSE TEMPLGTH 
IF LC > LCMAX 
LC := LLC; 
WITH GATTR DO 

BEGIN NEW (TYPTR, ARRAYS i TRUE* TRUE) 
TYPTR* := STRGPTR~; 
TYPTR^.MAXLENG := TEMPLGTH 

END 
END (*CONCAT*) J 



stp; 



STRGLGTH THEN 
(TEMPLGTH DIV 
:= STRGLGTH; 
THEN LCMAX 



CHRSPERWD) + 1 



= LC 



PROCEDURE 


copydelete; 


VAR LLC! 


; addrrange; lsp: 


BEGIN 




IF LKEY 


= 19 THEN 


BEGIN 


llc := lc; 


LC : 


1= LC + (STRGLGTH 


end; 




IF LKEY 


<> 43 THEN 


BEGIN 





DIV CHRSPERWD) + 1 
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STRGVAK<FSYS + CCOMMADt LKEY = 18); 
IF LKEY = 19 THEN 

BEGIN lsp := gattr.typtr; 

GEN2(50(*lDA*) »0,LLC) 

end; 
if sy = comma then insymbol else error<20)5 

end; 
expression(fsys + ccommad); load; 
if gattr.typtr <> nil then 

if gattr.typtr <> intptr then err0r(125>; 
if sy = comma then insymbol else error<20>? 
expression(fsys + crparent3)? load; 
if gattr.typtr <> nil then 

if gattr.typtr <> intptr then error(125)5 
if lkey = 19 then 

BEGIN 

GEN2(77(*CXP*),0(*SYS*)»25(*SCOPY*))« 

GEN2(50(*LDA*),0.LLC) ; 

IF LSP^.MAXLENG < STRGLGTH THEN 

LC := LLC + (LSP A .MAXLENG DIV CHRSPERWD) + It 
IF LC > LCMAX THEN LCMAX := LC? 
LC := LLC? GATTR.TYPTR := LSP 
END 
ELSE 

IF LKEY = 43 THEN 

GEN2(77(*CXP*)t0(*SYS*) t29(*G0T0XY*)) 
ELSE GEN2(77(*CXP*) t < *SYS*) »26 ( *SDELETE* ) ) 
END (*COPYDELETE*) ; 

PROCEDURE STR; 
BEGIN 

WITH GATTR DO 
BEGIN 

IF COMPTYPES(LONGlNTPTRtTYPTR) THEN 
ELSE IF TYPTR = INTPTR THEN 
BEGIN 

GENLDC(18<*DCVT*) ) ; GENNR (DECOPS) ; 
TYPTR := LONGINTPTR 
END 
ELSE ERR0RU25) ; 
IF SY = COMMA THEN INSYMBOL ELSE ERROR(20); 
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STRGVARCFSYS + CRPARENT], TRUE); 
IF STRGTYPE(TYPTR) THEN 

BEGIN GENLDC(TYPTR*.iHAXLENG); GENLDC ( 12 ( *DSTR* ) ) 5 

3ENNP(UECOPS) 
END 
ELSE ERR0R(H6) ; 
END 
END (*STR*)i 

PROCEDURE CLOSE? 
BEGIN 

VARIABLEIFSYS + CCOMMAi RPARENT3) ; LOADADDRESS; 
IF GATTR.TYPTR <> NIL THEN 

IF GATTR.TYPTR^. FORM <> FILES THEN ERR0R(125)S 
IF SY = COMMA THEN 
BEGIN INSYMBOL; 

IF SY = IDENT THEN 
BEGIN 
IF ID = 'NORMAL • THEN GENLDC(O) 
ELSE 

IF ID = 'LOCK ♦ THEN GENLDC(l) 
ELSE 

IF ID = 'PURGE • THEN GENLDC(2) 
ELSE 

IF ID = 'CRUNCH ' THEN GENLDC(3) 
ELSE ERROR(2) ; 
INSYMBOL 
END 
ELSE ERR0R(2) 
END 
ELSE GENLDC(O) « 

GEN2(77(*CXP*) tO(*SYS*) »6(*FCL0SE*> ) J 
IF IOCHECK THEN GENl ( 30 ( *CSP* ) * (*IOC*) ) 
END <*CLOSE*> 5 

PROCEDURE GETPUTETC; 
BEGIN 

VARIABLE(FSYS + CCOMMA » RPARENT3 ) 5 LOADADDRESS; 
IF GATTR.TYPTR <> NIL THEN 

IF GATTR.TYPTR^. FORM <> FILES THEN ERR0RQ25) 

ELSE 
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34: 
35: 
40: 



IF GATTR.TYPTR-. FILTYPE = NIL THEN LRR0R<399); 
CASE LKEY OF 

32: BEGIM 

IF SY = COMMA THEM 
BEGIN 

insymbol; expressioncfsys + crparent^); load; 

IF GATTR.TYPTR <> INTPTR THEN ERR0R(125) 
ENU 

ELSE ERR0R(125) ; 

GENNR(SEEK) 
END? 

GEN2(77(*CXP*)iO(*SYS*)»7(*FGET*)) ; 

GEN2(77(*CXP*).0(*SYS*)»8(*FPUT*)) J 

BEGIN 

IF GATTR.TYPTR <> NIL THEN 

r r i rn^ T I R,TYPTRA ' FILTYPE ° C HARPTR THEN ERR0R<399); 
GENLDCQ2)? GENLDC(O); 

GEN2(77(*CXP*),0(*SYS*),17(*WRC*)) 

END 

END (*CASE») ; 

IF IOCHECK THEN GENl < 30 < *CSP*> . { *IOC*) ) 
END (*GETPUTETC*> ? 

PROCEDURE SCANJ 
BEGIN 

IF GATTR.TYPTR <> NIL THEN 

IF GATTR.TYPTR <> INTPTR THEN ERR0R<125); 

IF SY = COMMA THEN INSYMBOL ELSE ERROR(20); 
IF SY = RELOP THEN 
BEGIN 

IF OP = EQOP THEN GENLDC(O) 
ELSE 

IF OP = NEOP THEN GENLDC(l) 
ELSE ERR0R(125); 
INSYMBOL 
END 
ELSE ERR0RQ25) ; 

EXPRESSION(FSYS + CCOMMA3); LOAD? 
IF GATTR.TYPTR <> NIL THEN 

IF GATTR.TYPTR <> CHARPTR 
IF SY = COMMA THEN INSYMBOL 



THEN 
ELSE 



ERR0R(125); 
ERROR(20) ; 
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6YTEA0DRESS; 



VARIABLEIFSYS + CCOMMA t RPARENTD) 
IF SY = COMMA THEM 
BEGIN INSYMBOL; 

EXPRF.S3I0NCFSYS + CRPARENT3); LOAD 
END 
ELSE GENLDC(O) '• 
SEN1(30(*CSP*) »11{*SCN*) ) ; 
GATTR.TYPTR := INTPTR 
END (*SCAN*) ; 

PROCEDURE BLOCKIOJ 
BESIN 

VARIABLE(FSYS + CCOMMAD); LOADAODRESS; 
IF GATTR.TYPTR <> NIL THEN 

IF GATTR.TYPTR'*. FORM <> FILES THEN ERR0R(125> 
ELSE 

IF GATTR.TYPTR". FILTYPE <> NIL THEN ERR0R<399); 
IF SY = COMMA THEN INSYMBOL ELSE ERROR < 2'0> I 
VARIABLE(FSYS + CCOMMAD) J BYTEADDRESS? 
IF SY = COMMA THEN INSYMBOL ELSE ERRORUO); 
EXPRESSION(FSYS + CCOMMAt RPARENT3) ; LOAD; 
IF GATTR.TYPTR <> INTPTR THEN ERR0RU25); 
IF SY = COMMA THEN 
BEGIN INSYMBOL? 

EXPRESSIONIFSYS + CRPARENT3); LOAD? 
IF GATTR.TYPTR <> INTPTR THEN ERR0R(125) 
END 
ELSE GENLDC(-l) 5 
IF LKEY = 37 THEN GENLDC(l) ELSE GENLDC(O); 

genldc(O); genldc(O); 

SEN2{77(*CXP*)»0(*SYS*) t 28 < *BLOCKlO*) ) ; 
IF IOCHECK THEN GEN1 ( 30 ( *CSP*> » < *IOC* ) ) ; 
GATTR.TYPTR ;= INTPTR 
END (*BLOCKIO*) J 



PROCEDURE SIZEOF! 

VAR LCP: CTP; 
BEGIN 

IF SY = IDENT THEN 
BEGIN SEARCHID(VARS 
IF LCP^.IDTYPE <> 



+ CTYPES»FIELD3»LCP); 

NIL THEN 



INSYMBOL? 
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GENLQC(LCP'\IDTYPE~.SIZE*CHRSPERWD) 

end; 
gattr.typtr := intptr 

EfMJ (*SIZE0F*) ; 

BEGIN (*R0UTINE*) 
CASE LKEy OF 

12: newstmt; 
13,14: unitio; 
15: CONCATi 
18,i9,43:C0PYDELETE; 
21,22 t 27:M0VE; 
23; EXIT; 
31: CLOSE; 
32,34, 



35,40: 

36: 

37,38: 

<+i: 
42: 

END <*CASES*) 
END (*R0UTINE*) ; 



GETPUTETC; 

SCAN; 

8L0CKI01 

SIZEOF! 

STR 
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#5:bodypart.b.text*j 
#5:80dypart.c.text*) 

COPYRIGHT <C> 1979, REGENTS OF THE 
UNIVERSITY OF CALIFORNIA* SAN DIEGO 



*) 
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PROCEDURE L0ADIDADDR(FCP: CTP) 5 
BEGIN 

WITH FCP* DO 

IF KLASS = ACTUALVARS THEN 

IF VLEV = 1 THEN GEN1 (37( *LA0») t VADDR ) 
ELSE GEN2(50(*LDA*) »LEVEL-VLEV« VADDR ) 
ELSE (*FORMALVARS*) 

IF VLEV = 1 THEN GENl ( 41 < *LD0*) t VADDR) 
ELSE GEN2(54(*L0D*) .LEVEL-VLEV 1 VADDR ) 
END (*LOADIDADDR*) ; 

PROCEDURE READ; 
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VAR FILEPTR»LCp: CTPi 
BEGIN FILEPTR := INPUTPTR; 

IF (SY = IOENT) AND WASLPARENT THEN 
3ESIN SEARCHlD(VARS+CFIELDDiLCP) ; 
IF LCP~.IDTYPE <> NIL THEN 

IF LCP~.IDTYPE~.FORM = FILES THEN 

IF LCP~.IDTYPE".FILTYPE = CHARPTR THEN 
BEGIN INSYMBOL; FILEPTR := LCP; 

IF NOT (SY IN CCOMMA»RPARENTD) THEN ERROR(20); 
IF SY = COMMA THEN INSYMBOL 
END 
END 
ELSE 

IF WASLPARENT THEN ERROR(2); 
IF WASLPARENT AND (SY <> RPARENT) THEN 
BEGIN 

REPEAT LOADIDADDR(FILEPTR)! 

VARIABLE(FSYS + CCOMMA, RPARENT3) J 

IF GATTR, ACCESS = BYTE THEN ERROR(103)5 

LOADADDRESSs 

IF GATTR. TYPTR <> NIL THEN 

IF COMPTYPESdNTPTR, GATTR. TYPTR) THEN 
GEN2(77(*CXP*) i ( *SYS*) . 12 (*FRDI*) ) 
ELSE 

IF COMPTYPES(REALPTR, GATTR. TYPTR) THEN 

GENNR(FREADREAL) 
ELSE 

IF COMPTYPES(LONGINTPTRiGATTR. TYPTR) THEN 
BEGIN GENLDC(GATTR. TYPTR". SIZE) ; 

GENNR(FREADDEC) 
END 

ELSE 

IF COMPTYPES(CHARPTR, GATTR. TYPTR) THEN 

GEN2(77(*CXP*).0(*SYS«) ,16(*FRDC*) ) 
ELSE 

IF STRGTYPE(GATTR. TYPTR) THEN 

BEGIN GENLDC(GATTR. TYPTR". MAXLENG) 5 

GEN2(77(*CXP*),0(*SYS*) tl8(*FRDS*) ) 
END 
ELSE ERR0R(125) ; 
IF IOCHECK THEN GEN1 ( 30 (*CSP* ) t { *IOC*) ) 5 
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TEST := SY <> COMMA; 
IF NOT TEST THEN INSYMBOL 
UNTIL TEST 

r nj D ; 

IF |_KEY = 2 THEN 

BEGIN LOADIDADDR(FILEPTR) ; 

GEN2(77(*CXP*) »0(*SYS*) .21(*FRLN*) ) ; 

IF IOCHECK THEN GEN1 < 30 < *CSP* ) , < *I0C* ) > 

END 
END (*READ*) ; 

PROCEDURE WRITE; 

VAR LSP: STP; DEFAULT: BOOLEAN; 

FILEPTRiLCp: CTP; LEN,LMIN.LMAx: integer; 
BEGIN FILEPTR := OUTPUTPTR; 

IF (SY = IDENT) AND WASLPARENT THEN 

BEGIN SEARCHID(VARS + [FIELD. KONST t FUNC 3, LCP) ; 
IF LCP^.IDTYPE <> NIL THEN 

IF LCP^.IDTYPE^.FORM = FILES THEN 

IF LCP-.IDTYPE^.FILTYPE = CHARPTR THEN 
BEGIN INSYMBOL; FILEPTR := LCP! 

IF NOT (SY IN CCOMMAtRPARENTD) THEN ERROR(20H 
IF SY = COMMA THEN INSYMBOL 
END 
ENDJ 
IF WASLPARENT ANU (SY <> RPARENT) THEN 
BEGIN 

repeat loadidaddr(fileptr) ; 
expressi0n(fsys + ccomma .coloni rparentd) ; 
lsp := gattr.typtr; 

IF LSP <> NIL THEN 
WITH LSP~ DO 
BEGIN 

IF FORM > LONSINT THEN LOADADDRESS 
ELSE 

BEGIN LOAD; 

IF FORM = LONGINT THEN 

BEGIN GENLOC(DECSIZE(MAXDEO); GENLDC ( (*DAJ*) ) ; 

GENNR(DECOPS) 
END 
END 
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ElvID; 
IF SY = COLOM THEN 
BEGIN INSYMBOLJ 

tXPRESSIONCFSYS + C COMMA , COLON i RPARENT 3 ) ; 
IF GATTR.TYPTR <> NIL THEN 

IF GATTR.TYPTR <> INTPTR THEN ERROR(20)J 
LOAD; DEFAULT := FALSE 
END 
ELSE DEFAULT := TRUE; 
IF LSP = INTPTR THEM 

BEGIN IF DEFAULT THEN GENLDC(O); 

GEN2(77(*CXP*) tO(*SYS*) tl3(*FWRI*) ) 
END 
ELSE 

IF LSP = REALPTR THEN 

BEGIN IF DEFAULT THEN GEfJLDC(O)? 
IF SY = COLON THEN 
BEGIN INSYMBOLJ 

LXPRESSI0N(FSYS + CCOMMA.RPARENTH) J LOAD; 
IF GATTR.TYPTR <> NIL THEN 

IF GATTR.TYPTR <> INTPTR THEN ERR0RU25) 
END 
ELSE GENLDC(O) ; 
GENNK(FWRITEREAL) 
END 
ELSE 

IF COMPTYPES(LSP.LONGINTPTR) THEN 

BEGIN IF DEFAULT THEN GENLDC(O); GENNR ( FWRITEDEC ) 
ELSE 

IF LSP = CHARPTR THEN 

BEGIN IF DEFAULT THEN GENLDC(O); 

GEN2(77(*CXP*) «0<*SYS*) , 17(*FWRC*) ) 
END 
ELSE 

IF STRGTYPE(LSP) THEN 

BEGIN IF DEFAULT THEN GENLDC(O); 

GEN2(77(*CXP*) iO(*SYS*) «19(*FWRS*) ) 
END 
ELSE 

IF PAOFCHAR(LSP) THEN 
BEGIN LMAX := 0; 
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IF LSD-.INXTYPE <> NIL THEN 

BEGIN G£T30UNDS(LSP".INXTYPE,LMIN,LMAX) ; 
LMAX := LMAX - LMlN + l 

end; 

IF 3EFAUIT THEN GENLDC ( LMAX ) 5 
GENLDC(LMAX) 5 

GEN2(77(*CXP*),0(*SYS*) t2Q(*FWRB*)) 

END 

ELSE ERR0R(125) ; 
IF IOCHECK THEN GEN1 < 30 ( *CSP* ) , ( *IOC* ) ) ; 
TEST := SY <> COMMA; 
IF NOT TEST THEN INSYM30L 
UNTIL TEST; 
END? 
IF LKEY = 4 THEN <*WRITELN*) 
3EGIN LOADIDADDR(FILEPTR) ; 

GEN2(77(*CXP*)iO(*SYS*) ,22<*FWLN*)) ; 
IF IOCHECK THEN GENl ( 30 ( *CSP* ) , ( *IOC*) ) 
END 
END (*WRITE*) ! 

PROCEDURE CALLNONSPECIAL; 
LABEL l; 

var nxt,lcp: ctps lsp: stp; lb: boolean; 
lmin.lmax: integer! 

BEGIN 

WITH FCP~ DO 

BEGIN NXT := NEXT; 

IF PFDECKIND = DECLARED THEN 

IF PFKIND <> ACTUAL THEN ERROR(400) 
END; 

IF SY = LPARENT THEN 

BEGIN 

REPEAT 

IF NXT = NIL THEN ERR0RU26); 

INSYMBOL; 

EXPRESSI0N(FSYS + C COMMA • RPARENTD) ; 

IF (GATTR.TYPTR <> MID AND (NXT <> NIL) THEN 

BEGIN LSP := nxt^.idtype; 

IF <NXT*.KLASS = FORMALVARS) OR (LSP <> NIL) THEN 
BEGIN 
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IF NXT~.KLASS = ACTUALVARS THEN 

IF GATTR.TYPTR~.FORM <= POWER THEN 
BEGIN L3 := (GATTR.TYPTR = CHARPTR) 
AND (GATTR.KIND = CST) 5 
LOAD? 
IF LSP*.FORM = POWER THEN 

GEN1(32(*ADJ*) .LSP^.SIZE) 
ELSE 

IF LSP^.FORM = LONGINT THEN 
BEGIN 

IF GATTR.TYPTR = InTPTR THEN 

BEGIN GENLDCQ8UDCVT*) ) ; GENNR ( DECOPS ) ; 

GATTR.TYPTR := LONGINTPTR 
END! 
GENLDC(LSP*.SIZE> 5 
GENLDC(0(*DAJ*))5 
GENNR(DECOPS) 
END 
ELSE 

IF (LSP-.FORM = SUBRANGE) 
AND RANGECHECK THEN 
BEGIN GENLDC(LSP".MIN.IVAL) J 
GENLDC(LSP~.MAX.IVAL> ; 
GEN0(8<*CHK*>) 
END 
ELSE 
IF (GATTR.TYPTR = INTPTR) AND 

COMPTYPES(LSP,REALPTR) THEN 
BEGIN GEN0(10(*FLT*)) J 

GATTR.TYPTR := REALPTR 
END 
ELSE 

IF LB AND STRGTYPE(LSP) THEN 
GATTR.TYPTR := STRGPTR 
END 
ELSE (*FORM > POWER*) 

BEGIN LB := STRGTYPE(GATTR.TYPTR) 

AND (GATTR.KIND = CST) ? 
LOADADDRESS; 

IF LB AND PAOFCHAR(LSP) THEN 
IF NOT LSP^.AISSTRNG THEN 
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BEGIN STRGTOPA(STRGCSTIC) ! 
IF LSP~.INXTYPE <> NIL THEN 
BEGIN 

GETBOUNDS(LSP'MNXTYPEtLMIN.LMAX); 
IF LMAX-LMIN+1 <> 

GATTR.TYPTR-.MAXLENG THEN ERR0R(112); 
END; 
SATTR.TYPTR := LSP 
END 



END 



ELSE (*KLASS = FORMALVARS*) 
IF GATTR.KIND = VARBL THEN 
BEGIN 

IF GATTR. ACCESS = BYTE THEN ERROR(103); 

LOADADDRESS; 

IF LSP <> NIL THEN 

IF LSP%FORM IN CP0WER»L0NGINT3 THEN 
IF GATTR. TYPTR*. SIZE <> 

LSP~.SIZE THEN ERR0R(112) 
END 
ELSE ERR0R(151)J 
IF NOT COMPTYPES(LSP, GATTR. TYPTR) THEN ERR0RU12) 
END 

end; 
if nxt <> nil then nxt := nxt^.next 
until sy <> comma; 

if sy = rparent then insymbol else error(i) 
end <*lparent*> ; 
if nxt <> nil then err0ru26); 
with fcp a do 
if pfdeckind = declared then 

BEGIN 

IF KLASS = FUNC THEN 

BEGIN GENLDC(O); GENLDC(O) END; 
IF INMODULE THEN 
IF SEPPROC THEN 

IF (PFSEG = SEG) AND (PFLEV = 1) THEN 

BEGIN GEN1(79(*CGP*).0); LINKERREF (PROC «-PFNAME t IC-1 ) END 
ELSE 

IF PFLEV = THEN GEN2 ( 77 ( *CXP* ), PFSEG . PFNAME ) 
ELSE ERROR(105) (*CALL NOT ALLOWED IN SEP PROC*) 
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ELSE 

IF IMPORTED THEM 

BEGIN GEN2(77(*CXP*) .0,PFNAME) ; LINKERREF ( PROC , PFSEG, IC-2 ) END 
ELSE GOTO 1 
ELSE 
1: IF PFSEG <> SEG THEN 

GEN2(77(*CXP*) . D FSEG , PFNAME ) 
ELSE 

IF PFLEV = THEN GEN1 (66 { *C8P* ) ,PFNAME ) 
ELSE 

IF PFLEV = LEVEL THEN GEN1 ( 78 ( *CLP* ), PFNAME) 
ELSE 

IF PFLEV = 1 THEN GEN1 ( 79( *CGP*) tPFNAME) 
ELSE GEN1(46(*CIP*) .PFNAME) 
END 
ELSE 

IF CSPNUM = 23 THEN GEN1(30»4Q) (* TEMP 1.5 TRANSLATION — 

MEM WILL BE CSP 23 IN II. *) 
ELSE 

IF (CSPNUM <> 21) AND (CSPNUM <> 22) THEN 
GEN1 ( 30 (*CSP*)t CSPNUM) ; 

gattr.typtr := fcp^.idtype 
end (+callnonspecial*) 5 

begin (*call*) 
if fcp^.pfdeckind = special then 
begin waslparent := true; lkey := fcp^.key; 
if sy = lparent then insymbol 

ELSE 

IF LKEY IN C2.4,5i63 THEN WASLPARENT := FALSE 

ELSE ERR0R(9); 
IF LKEY IN C7. 8.9,10*11. 13.14, 25, 36,39*423 THEN 

BEGIN EXPRESSION(FSYS + CCOMMA,RPARENT] ) } LOAD END! 
IF LKEY IN Cl2tl3, 14, 15,18.19, 21,22, 23.27*31, 32, 34, 35, 36*37*38, 

40*41,42*433 THEN ROUTINE( LKEY ) 
ELSE 

case lkey of 
1,2: read; 

3,4: WRITE; 

5,6: BEGIN UEOF & EOLN*) 
IF WASLPARENT THEN 
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BEGIN VARIA3LE(FSYS + C RPARENT ] ) ; LOADADDRESS; 
IF GATTR.TYPTR <> NIL THEN 

IF GATTR.TYPTR-. FORM <> FILES THEN ERR0R(125) 
ELSE 

IF (GATTR.TYPTR^.FILTYPE <> CHARPTR) AND 
(LKEY = 6) THEN ERR0R(399) 
LND 
ELSE 

LOADIDADDR(INPUTPTR) 5 
GENLDC(O); GENLDC(O); 

IF LKEY = 5 THEN GEN2 ( 77 ( *CXP*) , ( *SYS* ) , 10 < *FEOF* ) ) 
ELSE GEN2(77(*CXP*),0(*SYS*),11(*FEOLN*)); 
GATTR.TYPTR := BOOLPTR 
END (*EOF*) ; 
7,8: BEGIN GENLDC(l); (*PREDSUCC*) 
IF GATTR.TYPTR <> NIL THEN 

IF GATTR.TYPTR*. FORM = SCALAR THEN 
IF LKEY = 8 THEN GENO (2 ( *ADI* ) ) 
ELSE SEN0(21(*SBI*) ) 
ELSE ERR0RU15) 
END (*PREDSUCC*) ; 
9.* BEGIN (*0RD*) 

IF GATTR.TYPTR <> NIL THEN 

IF GATTR.TYPTR*. FORM >= POWER THEN ERR0RU25); 
GATTR.TYPTR := INTPTR 
END (*ORD*) ; 
10: BEGIN (*SOR*) 

IF GATTR.TYPTR <> NIL THEN 

IF GATTR.TYPTR = INTPTR THEN GENO (24(*SQI* ) ) 

ELSE 

IF GATTR.TYPTR = REALPTR THEN GENO <25< *SQR*) ) 
ELSE BEGIN ERR0R(125); GATTR.TYPTR := INTPTR END 
END <*SaR*) ; 
11: BEGIN (*ABS*) 

IF GATTR.TYPTR <> NIL THEN 

IF GATTR.TYPTR = INTPTR THEN GENO ( ( *ABI*) ) 
ELSE 

IF GATTR.TYPTR = REALPTR THEN GENO ( 1 ( *ABR* ) ) 
ELSE BEGIN ERR0R(125); GATTR.TYPTR := INTPTR END 
END <*ABS*) ; 
16: BEGIN ULENGTH*) 
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STKGVAR<FSYS + C RPARENT 3 1 FALSE ) ; 
GENLDC(0(*IMOEX*))S GENO ( 62 ( *|_D3* ) ) 5 GATTR.TYPTR 

END (*LENGTH*) 5 
17: 3EGIN (*INSERT*) 

STKGVAR(FSYS + C COMMA 1 1 FALSE ) ; 

IF SY = COMMA THEN IMSYMBOL ELSE ERROR(20>5 

STKGVAR(FSYS + CCOMMADiTRUE) 5 

GENLDC(GATTR.TYPTR*.MAXLENG) 5 

IF SY = COMMA THEN IMSYMBOL ELSE ERROR(20); 

EXPRESSION(FSYS + CRPARENTD); LOAD! 

IF GATTR.TYPTR <> NIL THEN 

IF GATTR.TYPTR <> INTPTR THEN ERR0RU25); 

GEN2(77(*CXP*) 1 ( *SYS* ) t 24 ( *SINSERT* ) ) 
END (+INSERT*) 5 
20: BEGIN (*POS*) 

STRGVAR(FSYS + C COMMA D» FALSE ) ; 

IF SY = COMMA THEN INSYMBOL ELSE ERROR(20); 

STRGVAR(FSYS + CRPARENT3, FALSE ) ! 

GENLDC(O); GENLOC(O); 

GEN2(77(*CXP*) t ( *SYS* ) t 27 ( *SPOS* ) ) 5 

GATTR.TYPTR := INTPTR 

END (*pos*> ; 

24: BEGIN (*IDSEARCH*) 

VARIABLEJFSYS + CCOMMAH); LOADADDRESS; 

IF SY = COMMA THEN INSYMBOL ELSE ERROR(20)J 

VARIABLE<FSYS + CRPARENT3); LOADADDRESS; 

GEN1(30(*CSP*) t7(*IDS*> ) 
END UIDSEARCH*) ; 
25: BEGIN (*TREESEARCH*) 

IF SY = COMMA THEN INSYMBOL ELSE ERRORC20); 

VARIA8LE(FSYS + CCOMMAD); LOADADDRESS? 

IF SY = COMMA THEN INSYMBOL ELSE ERROR(20>! 

VARIABLE(FSYS + C RPARENTD > ; LOADADDRESS; 

GATTR.TYPTR := INTPTR; 

GEN1(30(*CSP*) i8(*TRS*) ) 
END (*TREESEARCH*) ; 
261 BEGIN (*TIME*> 

VARIABLEtFSYS + CCOMMA3); LOADADDRESS; 

IF GATTR.TYPTR <> NIL THEN 

IF GATTR.TYPTR <> INTPTR THEN ERR0RU25); 

IF SY = COMMA THEN INSYMBOL ELSE ERROR(20); 
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VARIA8LE(FSYS + CRPARENTD); LOADADDRESS; 
IF GATTR.TYPTR <> NIL THEN 

IF GATTR.TYPTR <> INTPTR THEN ERR0R(125); 
GEN1(30(*CSP*) .9(*TIM*) ) 
EMD (*TIME*) ; 
33.23»29t30: 3EGIN ( *OPEN t RESET t REWRITE* ) 

VARIABLE(FSYS + CCOMMA tRPARENTD) ; LOADADDRESS; 
IF GATTR.TY°TR <> NIL THEN 

IF GATTR.TYPTR^.FORM <> FILES THEN ERROR(125)5 
IF SY <> COMMA THEN 
IF LKEY = 33 THEN 

GEN2(77(*CXP*) »0(*SYS*) »4(*FRESET*) ) 
ELSE ERRORJ20) 
ELSE 

BEGIN INSYMBOL; 

STRGVAR(FSYS + CRPARENT3, FALSE ) ; 
IF (LKEY = 28) OR (LKEY = 30) THEN 

GENLDC(O) 
ELSE GENLDC(l); 

GENLDC(O) ; GEN2(77(*CXP*)»0(*SYS*),5(*FOPEN*)) 
END; 
IF IOCHECK THEN GEN1 (30 ( *CSP* ) 1 (*IOC* ) ) 
END (*OPEl\l*) 5 
39: BEGIN (*TRUNC*) 

IF GATTR.TYPTR = INTPTR THEN 
BEGIN GENO(10(*FLT*) ) ; 

GATTR.TYPTR := REALPTR 
END; 
IF GATTR.TYPTR <> NIL THEN 

IF GATTR.TYPTR = REALPTR THEN 

GEN1(30(*CSP*) »23(*TRUNC*) ) (*** TEMPORARY -- 

TRUNC WILL BE CSP 14 IN II. ***) 
ELSE 

IF GATTR.TYPTR'*. FORM = LONGINT THEN 
BEGIN 

GENLDC(20(*DTNC*) ) ; GENNR (DECOPS ) 
END 
ELSE ERR0RU25); 
GATTR.TYPTR := INTPTR 
END 
END (*SPECIAL CASES*) ; 
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lilt }* 21;3 12 IF "WSLPAREMT ™EN 

3316 14 21-P ^ IF SY = RPARtNT THEN INSYM30L ELSE ERR0R(4) 

5317 ft Si.'f ?a EN1 ( * SPEC ™ L PROCEDURES AND FUNCTIONS*) 

<M J 1!1 2 ^ ELSE CALLNONSPECIAL 

^-•316 13 2i;o 31 END <*CALL*) ; 

«J1 ^* J 110 54 ( * $I ^••lOOYPART.C.TEXT*) 

III, It I 1 '' St * <**I a5:300YPART.D.TEXT*) 

3320 13 2i:j 54 

3322 J* pJiS ^ ( * COPYRIGHT (C) 1979, REGENTS OF THE *> 

5225 H H\ Q 54 ( * UNIVERSITY OF CALIFORNIA, SAN DIEGO *) 

3325 \l \V.° I PROCEDURE EXPRESSION (*FSYs: SETOFSYS*); 

3326 7* I,*" I LASEL 1; ( * STRING COMPARE KLUDGE *) 

3327 II ll'n , VAR LA II R: ATTR? L ° P: OPERATORS TYPlND: INTEGER; 

3328 13 ll'-n J? lstrgic.lsize: addrrange; lstring,gstring: boolean; 

3329 11 Hlo It l,in, LM ax: integer; 

333? is tl\ D Q I BEGl" URE FL ° ATIT(VAR FSP: STP? F0RCEFLOAT: BOOLEAN,; 

3333 11 lul J IF begJn TR * TYPTR = REALPTR) ° R < FSP = REALPTR) OR FORCEFLOAT THEN 

3335 It IV>1 JJ IF GATTR.TYPTR = INTPTR THEN 

,335 lM JJ IF^p N = G L N ?^ ( ; H E L r ,,; 6 *™- T ™ '» "ALPTR ™« 

3338 Is n.-2 39 D BEGIN GE N0(9(*FLO*,,; FSP := REALPTR END 

"?? 13 n: 39 END (*FLOATIT*) ; 

3340 13 1i:o 52 

llll ]l uoin 1 PROCEDURE STRETCHIT ( VAR FSP: STP); 

•35H2 13 42 jo BEGIN 

|:j i| till ia ° IF I r^T^?:p; R L ^^ R °? H ^ ATTR - TYPTR "- F0RH ■ L0NG1NTi then 

3316 13 *IIS 27 e Je SIN SEN "-0C(18(.DCVT. ( ), GENNR < DECOPS) i GATTR.TYPTR !* L0N6INTPTR END 

till 13 !!:» « L IF Fsp = INTPTR THE " 

33*9 !3 " 2 :J '5 END i.ST^CHI^'rf' 1 '"* "*" 1 GEWR(D « 0P S) I FSP := LO NS1 NTPTR END 

3350 13 42:o 58 

335?" \l IV-'n I PROCEDURE SIMPLEEXPRESSION ( FSYS : SETOFSYS,; 

3353 J? H\o J VAR LATTR: ATTR5 L0P: OP£:R ATOR; SIGNED: BOOLEAN; 
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PROCEDURE TERMfFSYS: SETOFSYS); 

var latth: attr; l sp: stp; lop: operator; 

PROCEDURE FACTOR(FSYS: SETOFSYS); 

VAR LSP-' stp' MTr^^Vn ' ARPART ' ALLC0NST: BOOLEAN, 

cs?^: , se? 6 Sf a !;:';s?; l,lic,lop: integer; 

BEGIN 

IF NOT (SY IN FACBEGSYS) THEN 

BEGIN ERR0R(58); SKIP(FSYS + FACBEGSYS); 
GATTR.TYPTR := NIL 

end; 

WHILE SY IN FACBEGSYS DO 
BEGIN 

CASE SY OF 

(*id*) ident: 

BE insymb2l;^ 
if lcp a .klass = func then 

BEGIN CALL(FSYStLCP); GATTR.KIND := EXPR END 
EL«L 

IF LCPA.KLASS = KONST THEN 
WITH GATTRt LCP~ DO 

BEGIN TYPTR := IDTYPEJ KIND := CSTJ 

CVAL := VALUES 
END 

ELSE SELECTOR(FSYS,LCP); 
IF GATTR.TYPTR <> NIL THEN 
WITH GATTR, TYPTR" DO 

END; IF F0RM = SUBRANGE THEN TYPTR : = RANGETYPE 

(*cst*j intconst: 

BEGIN 

WITH GATTR DO 

BEGIN TYPTR := INTPTR; KIND := CST; 
CVAL := VAL 

END; 
INSYMBOL 
END? 

realconst: 

BEGIN 
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KIND := CST 



:= CHARPTR 



(*(*) 



(*NOT*) 



WITH GATTR DO 

BEGIN TYPTR := REALPTR; 
CVAL := VAL 

end; 
insymbol 

END! 
STRIi'JGCONST: 
3EGIN 

WITH GATTR DO 
BEGIN 

IF LGTH = 1 THEN TYPTR 
ELSE 

BEGIN NEiAl(LSPtARRAYS»TRUE«TRUE) ; 
LSP" := STRGPTR*; 
LSP^.MAXLENG := LGTH; 
TYPTR := LSP 
END; 

kind := cst; cval := VAL 

END; 
INSYMBOL 

end; 
longconst: 

BEGIN 

with gattr do 
begin new(lsp.longint) ; 
lsp* := longintptr*; 
lsp". size := decsize(lgth) ; 
typtr := lsp; kind := cst; cval := val 
END; 
insymbol 

end; 
lparent: 
begin insymbol; expresslon(fsys 
if sy = rparent then insymbol 
end; 
notsy: 
with gattr do 
begin insymbol; factor(fsys) ; 

if (kind = cst) and (typtr = boolptr) then 
cval.ival := ord(not odd ( cval. ival) ) 

ELSE 



+ CRPARENT3) 5 
ELSE ERR0R(4) 
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bEGIN LOAD; GENO ( 19 ( *NOT*) ) 5 
IF TYPTR <> ,-JIL THEN 

IF TYPTR <> BOOLPTR THEN 

BEGIN ERR0R(135); TYPTR := NIL END 
END 
END; 
<*C*) L3RACK: 

begin insymbol; cstpart := c 3; VARPART := false; 

NEW(LSP, POWER) ; 
WITH LSP~ DO 

begin elset := nil; size := o; form := power end; 

IF SY = RBRACK THEN 
BEGIN 

WITH GATTR DO 

BEGIN TYPTR := LSP; KIND := CST END; 
INSYMBOL 
END 
ELSE 
BEGIN 

REPEAT EXPRESSION(FSYS + CCOMMA,RBRACK»COLON3) ; 
IF GATTR. TYPTR <> NIL THEN 

IF GATTR. TYPTR A . FORM <> SCALAR THEN 

BEGIN ERR0R(136M GATTR. TYPTR != NIL END 
ELSE 

IF COMPTYPES(LSP A .ELSET, GATTR. TYPTR) THEN 
BEGIN ALLCONST := FALSE? LOP := 23(*SGS*)» 
IF (GATTR. KIND = CST) AND 

(GATTR. CVAL.IVAL <= 127) THEN 
BEGIN ALLCONST := TRUE; 

LOWVAL := GATTR. CVAL.IVAL; 
HIGHVAL 1= LOWVAL 
END,* 
LIC .*= IC5-LOAD5 
IF SY = COLON THEN 

BEGIN INSYMBOLJ LOP := 20(»SRS*); 
EXPRESSION(FSYS + CCOMMA .RBRACK]) ; 
IF COMPTYPES(LSP A . ELSET, GATTR. TYPTR) THEN 
ELSE 

BEGIN ERR0RU37); GATTR. TYPTR:=NIL END; 
IF ALLCONST THEN 

IF (GATTR. KIND = CST) AND 
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(GATTR.CVAL.IVAL <= 127) THEN 
HIGHVAL := GATTR.CVAL.IVAL 
ELSE 

BEGIN LOAD; ALLCONST := FALSE END 
ELSE LOAD 
END; 
IF ALLCONST THEN 

BEGIN IC := LIC; (*FORGET FIRST CONST*) 

CSTPART := CSTPART + CLOWVAL. .HIGHVAL3 
END 
ELSE 

begin geno(lop) j 
if varpart then geno (28< *uni* ) ) 
else varpart := true 
end; 
lsp^.elset := gattr.typtrl 
gattr.typtr 1= lsp 

END 
ELSE ERROR (137); 
TEST := SY <> COMMA; 
IF NOT TEST THEN INSYMBOL 
UNTIL TEST? 

IF SY = RBRACK THEN INSYMBOL ELSE ERR0RU2) 
END; 
IF VARPART THEN 
BEGIN 

IF CSTPART <> C 3 THEN 
BEGIN 

SCONST*. PVAL := CSTPART; 
SCONST^.CCLASS := PSET? 
GATTR.CVAL.VALP := SCONST; 
GATTR.KIND := CST; 
LOAD? GEN0(28(*UNI*)) 
END; 
GATTR.KIND 1= EXPR 
END 
ELSE 
BEGIN 

sconst^.pval := cstpart! 
sconst^.cclass := pset; 
gattr.cval.valp := sconst; 
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GATTR.KINC := CST 
END 
t. N [..■ 
END (*CASE*) ; 
IF NOT (SY IN FSYS) THEN 

BEGIN ERR0R(6); SKIP(FSYS + FACBEGSYS) END 
END (*WHILE*) 
END (*FACTOR*) ; 

BEGIN (+TERM*) 

PACTORIFSYS + CMULCPJ); 
WHILE SY = MULUP DO 

BEGIN LOAD; LATTR := SATTR; LOP := OP5 
INSYMBOL; FACTOR(FSYS + CMULOP3); LOAD; 

IF (LATTR. TYPTR <> NIL) AND (GATTR.TYPTR <> NIL) THEN 
CASE LOP OF 
(***) MUL: BEGIN FLOATITUATTR. TYPTR. FALSE)? STRETCHIT( LATTR. TYPTR ) { 

IF (LATTR. TYPTR = INTPTR) AND (GATTR.TYPTR = INTPTR) 

THEN GEN0(15(*MPI*) ) 
ELSE 

IF (LATTR. TYPTR = REALPTR) AND 

(GATTR.TYPTR = REALPTR) THEN GENO < 16( *MPR») ) 
ELSE 

IF (GATTR.TYPTR A .FORM = LONGINT) AND 
(LATTR. TYPTR*. FORM = LONGINT) THEN 
BEGIN GENLDC(8(*DMP*) ) ; GENNR (DECOPS ) END 
ELSE 

IF (LATTR. TYPTR*. FORM = POWER) 

AND COMPTYPES(LATTR. TYPTR, GATTR.TYPTR) THEN 
GEN0(12(*INT*) ) 

ELSE BEGIN ERR0RU34); GATTR.TYPTR: =NIL END 
END; 
(*/*) RDIV: BEGIN FLOATIT(LATTR. TYPTR. TRUE) ; 

IF (LATTR. TYPTR = REALPTR) AND 

(GATTR.TYPTR = REALPTR) THEN GENO ( 7 (*DVR*) ) 
ELSE BEGIN ERR0R(l34); GATTR.TYPTR := NIL END 
END; 
(*QIV*) IDIV: BEGIN STRETCHIT(LATTR. TYPTR); 

IF (LATTR. TYPTR = INTPTR) AND 

(GATTR.TYPTR = INTPTR) THEN GENO ( 6( *DVI* ) ) 
ELSE 
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if (lattr.typtr~.form = longint) amd 
(gattr.typtr~.form = longint) then 
begin genldc(10(*ddv*)>; gennr ( decops ) end 
else begin error(134); gattr.typtr := nil end 
end; 
CMOO*) IMOD: IF (LATTR.TYPTR = INTPTR) and 

(GATTR.TYPTR = INTPTR) THEN GENO ( 14 ( *MOD* ) ) 
ELSE BEGIN ERROR(134)5 GATTR.TYPTR := NIL END; 
(♦AND*) ANDOPJlF (LATTR.TYPTR = BOOLPTR) AND 

(GATTR.TYPTR = BOOLPTR) THEN GENO < 4 < *AND* ) ) 
ELSE BEGIN ERR0R(134); GATTR.TYPTR := NIL END 
END (*CASE*) 
ELSE GATTR.TYPTR := NIL 
END (*WHILE*) 
ENQ <*TERM*) ; 

BEGIN (*SIMPLEEXPRESSI0N*) 
SIGNED := FALSE? 
IF (SY = ADDOP) AND (OP IN CPLUS* MINUS!) THEN 

BEGIN SIGNED := OP = MINUS; INSYMBOL END; 
TERM(FSYS + CADDOP]) ; 
IF SIGNED THEN 
3EGIN LOAD; 

IF GATTR.TYPTR = INTPTR THEN GENO ( 17 ( *NGI* ) ) 
ELSE 

IF GATTR.TYPTR = REALPTR THEN GENO ( 18 ( *NGR* ) ) 
ELSE 

IF GATTR.TYPTR~.FORM = LONGINT THEN 

BEGIN GENLDC(6(*DNG*) ) ; GENNR ( DECOPS ) END 
ELSE BEGIN ERR0R(134); GATTR.TYPTR := NIL END 
END; 
WHILE SY = ADDOP DO 

BEGIN LOAD; LATTR := GATTR; LOP := OP; 
INSYMBOL! TERM(FSYS + CADDOPD); LOAD; 
IF (LATTR.TYPTR <> NIL) AND (GATTR.TYPTR <> NIL) THEN 

case lop of 
(#+*) plus: 

BEGIN FL0ATIT(LATTR.TYPTR, FALSE) ; STRETCHIT ( LATTR .TYPTR ) ; 
IF (LATTR.TYPTR = INTPTR ) AND ( GATTR .TYPTR = INTPTR) THEN 

GEN0(2(*ADI*) ) 
ELSE 
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1F GENo[I?;IJrIm = RE * LPTR >AND<GATTR.TYPTR = REALPTR, THEN 
ELSE 

IF (GATTR.TYPTR~.FORM = LONGINT) AND 
(LATTR.TYPTR~.FORM = LONGINT) THEN 
BEGIN GENLDC(2(*DAD*)); GENNR (DECOPS) END 

t- L. o t_ 

IF (LATTR.TYPTR~.FORM = POWER) 

*^,|:° MPTYPE:S <I-ATTR.TYPTR, GATTR.TYPTR) THEN 
t>ENQ<28(*UNI*) ) nt " 

END; ELSE BESIN ERR0R(13I *>* GATTR.TYPTR := NIL END 

(*-*) minus: 

3 "f\[a?t\ TI tJp^ ' ST ^TCHIT(LATTR.T YP TR, ; 

GEnSII!;IsBi!)7 1NPTR) AN ° (GATTR - T *PTR = INTPTR, THEN 
ELSE 

IF THES T «NjIL T <.SBR'n PTR ' AN ° <GATTR - T * PTR = R «LPTR, 
ELSE 

IF (GATTR.TYPTR~.FORM = LONGINT) AND 
(LATTR.TYPTR~.FORM = LONGINT) THEN 
BEGIN GENLDC(4(*DSB*)){ GENNR (DECOPS) END 

IF (LATTR.TYPTR~.FORM = POWER) 

GEN0?5^^ THEN 

END? ELSE BEGIN ERR0R(131f) ' GATTR.TYPTR := NIL END 

(*or*) orop: 

IF GEN5a T 3;IIoR T * R ,; B0 ° LPTR) AN ° (GATTR . T ^TR = BOOLPTR, THEN 
END (*?ASE*? IN ERR ° R(13tf,; GATTR.TYPTR : = NIL END 

ELSE GATTR.TYPTR := NIL 
END (*WHILE*) 
END (*SlMPLEEXPRE:SSION*) ; 

PROCEDURE MAKEPA(VAR STRGFSP: STP; PaFSP' STP): 
VAR LMIN.LMAX: INTEGER; 

BEGIN 
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IF PAFSP^.IIMXTYPE <> NIL THEN 

a.EGIN GET30UNDS(PAFSP~.If\IXTYPEtLMINiLMAX) 
IF LMAX-LVIli\l + l <> STRSFSP A .N!AXLENG THEN 
END! 
ST3GFSP := PAFSP 
END (*MAKEPA*) ; 



ERR0R(129) 



BEGIN (*EXPRE 
SIMPLEEXPRE 
IF SY = REL 
BEGIN 

LSTRING 

IF GATT 
IF GA 
ELSE 

lattr : 

INSYMBO 
GSTRING 

IF GATT 

IF GA 

ELSE 

IF (LAT 

IF LO 

IF 

I 

E 
ELS 

ELSE 
BEG 
I 



I 



SSION*) 
SSION(FSYS 

OP THEN 



+ CRELOPD) 



;= (GATTR.KIND = CST) AND 

(STRGTYPE(GATTR.TYPTR) OR (GATTR.TYPTR = CHARPTR)); 
R.TYPTR <> NIL THEN 

TTR.TYPTR^.FORM <= POWER THEN LOAD 
LOADADDRESS; 

= GATTRJ LOP := OP5 LSTRGIC := STRGCSTIC; 
L; SIMPLEEXPRESSION(FSYS) ; 

:= (GATTR.KIND = CST) AND 

(STRGTYPE(GATTR.TYPTR) OR (GATTR.TYPTR = CHARPTR)); 
R.TYPTR <> NIL THEN 

TTR.TYPTR A .FORM <= POWER THEN LOAD 
LOADADDRESS? 

TR.TYPTR <> NIL) AND (GATTR.TYPTR <> NIL) THEN 
P = INOP THEN 

GATTR.TYPTR**. FORM = POWER THEN 
F COMPTYPESlLATTR.TYPTRtGATTR.TYPTR^.ELSET) THEN 

GEN0(1K*INN*) ) 
LSE BEGIN ERROR(129)5 GATTR.TYPTR := NIL END 
E BEGIN ERROR(130)5 GATTR.TYPTR := NIL END 



IN 

F LATT 

BEGIN 

F LSTR 

BEGIN 

IF 

I 



R.TYPTR <> GATTR.TYPTR THEN 

FLOATITUATTR.TYPTR, FALSE) ; 
ING THEN 



STRETCHIT(LATTR.TYPTR) END; 



PAOFCHAR(GATTR.TYPTR) THEN 

F NOT GATTR.TYPTR^.AISSTRNG THEN 

BEGIN STRGTOPA(LSTRGIC) ; 

MAKEPA( LATTR. TYPTR. GATTR.TYPTR) 

END 
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THEN 



END 
ELSE 

IF GSTKING THEN 
BEGIN 

IF PAOFCHAR(LATTR.TYPTR) THEN 
IF 'MOT LATTR. TYPTR-. AISSTRNG 
BEGIN STRGTOPA(STRGCSTIC) ; 

MAKEPA(GATTR.TYPTR,LATTR.TYPTR) 

END; 

end; 

IF (LSTRING AND STRGTYPE ( GATTR. TYPTR ) ) OR 

(GSTRING AND STRGTYPE<LATTR. TYPTR ) ) THEN GOTO 1: 
IF COMPTYPES(LATTR. TYPTR, GATTR. TYPTR) THEN 

8E c^ L ^ R : T % P L ^K- SI2Ei ,,INVAUD " R L0NS integers *' 

scalar: 
if lattr. typtr = realptr then typind := 1 

ELSE 

IF LATTR. TYPTR = BOOLPTR THEN TYPIND := 3 
ELSE TYPIND := 0; 
POINTER: 
BEGIN 

TYPIN P •- CLTOP,LEOP » STOp » S EOP3 THEN ERROR(l 3 l)5 

END; 
LONGINT! TYPIND := 7; 
POWER: 

BEGIN 

IF LOP IN CLTOP.GTOPD THEN ERRORU32); 
TYPIND := 4 
END; 

arrays: 

BEGIN 

TYPIND := 6; 

IF PAOFCHARtLATTR. TYPTR) THEN 
IF LATTR. TYPTR-. AISSTRNG THEN 
U TYPIND .*= 2 

ELSE 

BEGIN TYPIND := 5; 

IF LATTR. TYPTR-. INXTYPE <> NIL THEN 
BEGIN 
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BOUNDS (LATTR.TY"PTR*.INXTYPE»LMIN»LKAX) ! 
ZE := UMAX - LMIN + 1 



LOP IN CLTOP,LEOPtGTOPiGEOP3 THEN ERROR(131) 



IN CLTOP»|_EOP,GTOP.GEOP3 THEN ERR0RU31); 

:= 6 



GET 
LSI 

END 
END 
ELSE 
IF 
END; 

records: 

BEGIN 

IF LOP 

TYPING 
END; 

files: 
begin error(133>5 typind := end 

end; 

if typind = 7 then 
begin genldc(ord(lop)) ; genldc ( 16(*dcmp* ) ) ; 

gennr(decops) 

END 
ELSE 

CASE LOP OF 

LTOP: GEN2(53(* 



leop: 
gtop: 
geop: 
neop: 
eqop: 

END 
END 

else err0rq29) 
end; 
gattr.typtr := boolptr; 

END (*SY = RELOP*) 
END (+EXPRESSION*) ; 



LES*),TYPIND»LSIZE); 
GEN2( 52 (*LEQ*)» TYPIND »LSIZE) J 
GEN2 ( 49 (*GRT*), TYPIND «LSIZE) ; 
GEN2( 48 (*GEQ»)» TYPIND tLSIZE) ; 
GEN2( 55 (*NE9*)» TYPIND »LSIZE) ; 
GEN2(47(*EQU*) f TYPlNDtLSIZE) 



GATTR.KIND := EXPR 



(*$I 
(*$I 

(* 
(* 



«5:30DYPART.D.TEXT*) 
85:30DYPART.E.TEXT*) 



COPYRIGHT (C) 
UNIVERSITY OF 



1979, REGENTS OF THE 
CALIFORNIA, SAN DIEGO 



*) 
*) 
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42 
44 
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PROCEDURE STATE^ENTCFSYS: SETOFSYS); 
LABEL l; 

var ^cp: ctp; ttop: disphange; llp: labelp; heap: "integer; 

PROCEDURE ASSIGNMENT (FCP: CTP); 

besJS s^c R ;oR^;s c r^^r^c";- 800L " Ni LMIN,LMAX: INTESER! 

IF SY = BECOMES THEN 

3EGIN LMAX := 0; CSTRING := FALSE; 
IF GATTR.TYPTR <> NIL THEN 

IF LOaSIJdHESS; SS = INDRCT) ° R (GATTR - TYP TR^FORM > POWER, THEN 

PAONLEFT := PAOFCHAR(GATTR.TYPTR); 

LATTR := GATTR; 

INSYMBOL! EXPRESSION(FSYS); 

IF GATTR, KIND = CST THEN 

XF^^T^r^mY CH4RPTR ' ° R STR ^<«TTR.TYPTR„ 
IF GATTR, TYPTR". FORM <= POWER THEN LOAD 
ELSE LOADADDRESS? 

IF (LATTR. TYPTR <> NIL) AND (GATTR.TYPTR <> NIL, THEN 
BEGIN ■■"-'* 

IF GATTR.TYPTR = INTPTR THEN 

IF COMPTYPESCREALPTR, LATTR. TYPTR, THEN 

BEGIN GENQ(10(*FLT*,,; GATTR.TYPTR • = REALPTR END: 
IF COMPTYPES(LONGINTPTR, LATTR. TYPTR, THEN K " LPTR EN °* 
BEGIN 

IF GATTR.TYPTR = INTPTR THEN 

BEGIN GENLDC(18(*DCVT*,,i GENNR (DECOPS, ; 

GATTR.TYPTR := LONGINTPTR 
END; 

IF GATTR. TYPTR". FORM <> LONGINT THEN 
END; BEGIN ERROR(129)5 GATTR.TYPTR := LONGINTPTR END 
IF PAONLEFT THEN 

IF LATTR. TYPTR". AISSTRNG THEN 

IF CSTRING AND (GATTR.TYPTR = CHARPTR, THEN 

GATTR.TYPTR := STRGPTR 
ELSE 
ELSE 

IF LATTR. TYPTR". INXTYPE <> NIL THEN 
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BE^IN GETBOLINDS<LATTR.TYPTR*.INXTYPE»LMINtLHAX) ; 
LMAX != L^IAX - LMIN + 1; 

IF CSTRING AND (GATTR.TYPTR <> CHARPTR) THEN 
BEGIN STRGTOPA(STRGCSTIC) 5 

IF LMAX <> GATTR.TYPTR*. MAXLENG THEN ERROR ( 1 
GATTR.TYPTR := LATTR.TYPTR 
END 
END 

else gattr.typtr := lattr.typtr; 
if comptypes(lattr.typtr»gattr.typtr) then 
case lattr.typtr~.form of 
subrange: begin 

if rangecheck then 

BEGIN 

GENLDC(LATTR.TYPTR^.MIN.IVAL) ! 
GENLDC(LATTR.TYPTR A .MAX.IVAL) ; 
GEN0(8(*CHK*)) 
END; 
STORE(LATTR) 
END; 

power: begin 

gen1 < 32 <*ad j* >» lattr.typtr*. size); 
store(lattr) 

end; 
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29) 



SCALAR, 
POINTER: 

longint: 



ARRAYS: 



recokds: 
files: 

end 

ELSE ERR0R(i29) 



store(LATTR); 

begin 

genldc(Lattr.typtr~.size> ; 
genldc(0<*daj*> ) ; 
gennr(DECOps); 
store(lattr) 

END! 
IF PAONLEFT THEN 

IF LATTR.TYPTR*. AISSTRNG THEN 

GEN1(42(*SAS*),LATTR.TYPTR~.MAXLENG> 
ELSE GEN1(40(*MOV*),(LMAX+1) DIV 2) 
ELSE GEN1(40(*MOV*) .LATTR.TYPTR*. SIZE) ; 
GENl < 40 <*M0V*), LATTR.TYPTR*. SIZE) 5 
ERR0R(146) 
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END 
END (*SY = BECOMES*) 
ELSE ERROR(bl) 
END (^ASSIGNMENT*) ; 

PROCEDURE GOTOSTATEMENT; 

3EGI^ LLP: LA3ELP '' F0UND: BOOLEAN; TTOP: DISPRANGE! 

IF mOT GOTOOK THEN ERROR(S); 
IF SY = INTCONST THEN 
BEGIN 

FOUND := FALSE; TTOP := TOP; 

WHILE DISPLAYCTTOP3. OCCUR <> BLCK DO TTOP := TTOP - i; 
LLP := DISPLAYCTTOP3.FLABELS 
WHILE {LLP <> NIL) AND NOT FOUND DO 
WITH LLP~ DO 

IF LABVAL = VAL.IVAL THEN 
BEGIN FOUND := TRUE; 

GENJMP(57(*UJP*) .CODELBP) 
END 

ELSE LLP := NEXTLAB; 
IF NOT FOUND THEN ERR0R(167)J 
INSYMBOL 
END 
ELSE ERR0RC15) 
END (*GOTOSTATEMENT*) ; 

PROCEDURE COMPOUNDSTATEMENT; 
BEGIN 

REPEAT 

REPEAT STATEMENT(FSYS ♦ CSEMICOLON.ENDSYT) 

UNTIL NOT (SY IN STATBESSYS); 

TEST := SY <> SEMICOLON? 

IF NOT TEST THEN INSYMBOL 
UNTIL TEST; 

IF SY = ENDSY THEN INSYMBOL ELSE ERR0RU3) 
END <*COMPOUNDSTATLMENET*) ; 

PROCEDURE IFSTATEMENT; 

3EG?N LCIX1 ' LCIX2: LBP5 LIC: INTEGER; CONDCOMPILE.NOTHENCLAUSE: BOOLEAN; 



421 



3886 


13 


bi:i 





.5987 


15 


5i: i 


4 


3883 


13 


51:1 


13 


3999 


13 


bi:a 


2:5 


3390 


13 


51:3 


29 


3391 


13 


5i:<+ 


32 


3892 


13 


5i : q. 


36 


3893 


13 


5113 


36 


389H 


13 


bi:i 


j9 


3395 


13 


51:2 


43 


3896 


13 


5i:i 


50 


3897 


13 


5i:i 


64 


3898 


13 


5i:i 


79 


3899 


13 


5112 


82 


3900 


13 


5112 


85 


3901 


13 


5i:i 


93 


3902 


13 


51:2 


98 


3903 


13 


51:3 


98 


3904 


13 


51:4 


02 


3905 


13 


51:3 


13 


3906 


13 


51:3 


26 


3907 


13 


51:4 


29 


3908 


13 


51:5 


29 


3909 


13 


51:4 


33 


3910 


13 


51:3 


36 


3911 


13 


51:2 


39 


3912 


13 


51:1 


41 


3913 


13 


51:2 


43 


3914 


13 


51:0 


48 


3915 


13 


51:0 


62 


3916 


13 


52ID 


1 


3917 


13 


52:0 


1 


3918 


13 


52:d 


1 


3919 


13 


52:0 


1 


3920 


13 


52:0 


1 


3921 


13 


52:0 


1 


3922 


13 


52:d 


1 


3923 


13 


52:0 


1 


3924 


13 


52!D 


1 


3925 


13 


52:0 


a 


3926 


13 


52:0 






conccompile := false.; 
expression (fsys + lthensyd); 
if (gattr.kind = cst) then 
if (gattr.typtk = boolptr) then 
begin condcompile := true; 
nothenclause := not odd ( gattr .cval . i val) ; 

LIC := IC 

end; 

IF NOT CONDCOMPILE THEN 

BEGIN GENLA3EL(LCIX1) ; GENF JP ( LCIX1 ) END; 
IF SY = THENSY THEN INSYMSOL ELSE ERR0R(52); 
STaTEMENT(FSYS + CELSESY3); 
IF CONDCOMPILE THEN 

IF NOTHENCLAUSE THEN IC := LIC 

ELSE LIC := IC! 
IF SY = ELSESY THEN 

BEGIN 

if not condcompile then 

begin genlabel(lcix2) ; genjmp (57 ( *ujp* ) »lclx2 ) ; putlabeh lcix1 ) end 
insymbol; statement(fsys) ; 
if condcompile then 

BEGIN 

IF NOT NOTHENCLAUSE THEN IC := LIC 
END 
ELSE PUTLABEL(LCIX2) 

END 

ELSE 

IF NOT CONDCOMPILE THEN PUTLABEL (LCIX1 ) 

END (*IFSTATEMENT*) 5 

PROCEDURE CASESTATEMENT; 
LA3EL I! 

TYPE CIP = '"CASEINFO; 
CASEINFO = RECORD 

next: CIP; 

CSSTART: INTEGER; 
CSLAB: INTEGER 
END; 

va* lspiLSpi: stp; FSTPTRtLPTi.LPT2»LPT3: CIP; lval: VALUJ 

LADDRt LClx: LBP! NULSTMT, LMIN, LMAX: INTEGER; 
BEGIN EXPRESSION(FSYS + C OFSY t COMMA » COLON 3 ) ; 
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load; genlabelucix) ; gemj , ip(57(*ujp*j ,lcix) ; 
lsp := gattr.typtr; 
if lsp <> nil then 

IF (LSP*. FORM <> SCALAR) OR (LSP = REALPTR) THEN 
BEGIN ERR3R(144)i LSP := NIL END; 
IF SY = OFSY THEN INSYMBOL ELSE ERROR(8)5 
FSTPTR := NIL; GENLABEL(LADDR) ; 
REPEAT 

LPT3 := NIL; 

REPEAT CONSTANTCFSYS + CCOMMA » COLON} , LSPl » LVAL) ? 
IF LSP <> NIL THEN 

IF C0MPTYPES(LSP,LSP1) THEN 

BEGIN LPT1 := FSTPTR; LPT2 := NIL; 
WHILE LPTl <> NIL DO 
WITH LPTl* DO 
BEGIN 

IF CSLAB <= LVAL.IVAL THEN 

BEGIN IF CSLAB = LVAL.IVAL THEN ERR0R(156M 

GOTO 1 
END; 
LPT2 := LPTl! LPTl := NEXT 

end; 
NEW(LPT3); 

with lpt3* do 

begin next := lptl; cslab := lval.ival? 
csstart := ic 

end; 
if lpt2 = nil then fstptr := lpt3 
else lpt2". next := lpt3 

END 
ELSE ERR0R(147) ; 

TEST := SY <> COMMA; 

IF NOT TEST THEN INSYMBOL 
UNTIL TEST; 

IF SY = COLON THEN INSYMBOL ELSE ERR0R(5)J 
REPEAT STATEMENT(FSYS + CSEMICOLON3) 
UNTIL NOT (SY IN STATBEGSYS}? 
IF LPT3 <> NIL THEN 

GENJMP(57(*UJP*) tLADDR) ; 
TEST := SY <> SEMICOLON; 
IF NOT TEST THEN INSYMBOL 
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UNTIL TEST OR (ST = ENDSY); 

PUTLASEL(LCIX) ; 

IF FSTPTR <> MIL THEN 

■3E6IN LMAX := f-STPTR~.CSLAB; 

LPT1 := FSTPTR; FSTPTR ;= NIL; 

REPEAT LPT2 := LPTl^.MEXT; LPTl*. NEXT := FSTPTR; 

FSTPTR : = LPTl! LPT1 := LPT2 
UNTIL LPTl = NIL! 

lmin := fstptr^.cslab; 

GEN0(44(*XJP*) ) ; 
GENWORD(LMIN) ; GEMWORD ( LMAX ) ; 
NULSTMT := IC; 
GENJMP(57(*UJP*) iLADDR) ; 
REPEAT 

WITH FSTPTR* DO 
BEGIN 

WHILE CSLAB > LMIN DO 

BEGIN GENWORD(IC-NULSTMT) 5 LMIN := LMIN + 1 END* 
GENWORD(IC-CSSTART) ; 
FSTPTR := NEXT; LMIN := LMIN + 1 

END 
UNTIL FSTPTR = NIL; 
PUTLABEL(LADDR) 



end; 

IF SY 



= ENDSY THEN INSYM30L ELSE ERR0R(13) 



END (*CASESTATEMENT*) ; 

PROCEDURE REPEATSTATEMENT; 

VAR LADDR: LBP; 
BEGIN GENLABEL(LADDR) ; PUTLABEL (LADDR ) ; 
REPEAT 

REPEAT STATEMENTtFSYS + C SEMICOLON . UNTILSY D ) 
UNTIL NOT (SY IN STATBEGSYS); 
TEST := SY <> SEMICOLON; 
IF NOT TEST THEN INSYMBOL 
UNTIL TEST; 
IF SY = UNTILSY THEN 

3EGIN INSYMBOL! EXPRESSION ( FSYS ) ; GENFJP( LADDR) 
END 
ELSE ERR0R(53) 
END (*REPEATSTATEMENT*) ; 
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PROCEDURE wlHILESTATEWENT; 

var laddr. lcix: lbp; 

BEGIN GEiJLABEU LADDR) ; PUTL ABEL ( LADDR ) ; 

EXPRESSIGfHFSrs + COOSYl); GENLABEL ( LCIX ) ; GENFJP ( LCIX ) ; 
IF ST = DOSY THEN INSYMBOL ELSE ERR0R(54); 

statement(fsys) i gei\|jmp(57(*ujp*) ,laddr) 5 putlabel(lcix) 
end uwhilestatement*) ; 

procedure forstatement; 
var lattr: attrs lsp: stp; lsy: symbol; 
lcix, laddr: lbp; 

BEGIN 

IF SY = IDENT THEN 

BEGIN SEARCHID(VARS,LCP) ; 
WITH LCP*, LATTR DO 

BEGIN TYPTR := IDTYPE; KIND := VARBL; 

if klass = actualvars then 
begin access := drct; vlevel := vlevi 
dplmt := vaddr 

END 
ELSE BEGIN ERRORU55); TYPTR := NIL END 

end; 
if lattr. typtr <> nil then 

IF (LATTR. TYPTR*. FORM > SUBRANGE) 

OR COMPTYPES(REALPTR, LATTR. TYPTR) THEN 
BEGIN ERR0RU43); LATTR. TYPTR := NIL END; 
INSYMBOL 
END 
ELSE 

BEGIN ERR0R(2)5 SKIP(FSYS + CBECOMES, TOSYtDOWNTOSY.DOSYD ) 
END • 

IF SY = BECOMES THEN 

BEGIN INSYMBOL; EXPRESSION (FSYS + CTOSY.DOWNTOSY,DOSY3) ; 
IF GATTR. TYPTR <> NIL THEN 

IF GATTR. TYPTR*. FORM <> SCALAR THEN ERR0RU44) 
ELSE 

IF COMPTYPES(LATTR. TYPTR, GATTR. TYPTR) THEN 
BEGIN LOAD; 

IF LATTR. TYPTR <> NIL THEN 

IF (LATTR. TYPTR*. FORM = SUBRANGE) AND RANGECHECK THEN 
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IF |_S 



BEGIN 

GENLDCtLATTR.TYPTR^.MIh.Iy/AL) ? 
GENLDC(LATTR.TYPTR~.MAX.IVAL) 5 
GEN0(3(*CHK*) } 
END; 
STORE(LATTR) 
END 
ELSE ERR0R(145) 



IN ERROR(5l)5 SKIP(FSYS + CTOSY. DOWNTOSY .DOSYD) END; 
BEL(LADDR) 5 

IN CTOSY,DOWNTOSY3 THEN 
IN LSY := SY; INSYMBOL; EXPRESSIONJFSYS + CDOSY3); 
F GATTR.TYPTR <> NIL THEN 

IF GATTR.TYPTR~.FORM <> SCALAR THEN ERR0R(144) 

ELSE 

IF COMPTYPES(LATTR.TYPTRtGATTR.TYPTR) THEN 

BEGIN LOAD; 

IF LATTR.TYPTR <> NIL THEN 

IF (LATTR.TYPTR~.FORM = SUBRANGE) AND RANGECHECK THEN 
BEGIN 

GENLDC(LATTR.TYPTR A .MIN.IVAL) ; 
GENLDC(LATTR.TYPTR~.MAX.IVAL> ; 
GEN0(8(*CHK*)) 
END? 
GEN2(56(*STR*) tOtLO? PUTLABEL {LADDR ) ! 

gattr != lattr; load? gen2( 54( *lod*) . ilc ) ; 

lc := lc + intsize; 

if lc > lcmax then lcmax := lc ; 

if lsy = tosy then gen2 ( 52 ( *leq*) . % intsize ) 

ELSE GEN2(48(*GEQ*) tOiINTSIZE) ; 

END 
ELSE ERR0R(145) 

BEGIN ERRCR<55); SKIP(FSYS + CDOSY3) END; 
BEL(LCIX) ; GENJMP ( 33 ( *FJP*) »LCIX) ; 

= DOSY THEN INSYMBOL ELSE ERROR(54)5 
MENT(FSYS) ; 

:= LATTR; LOAD; GENLDC(l); 
Y = TOSY THEN GENO ( 2 ( *ADI* ) ) ELSE GENO ( 21 ( *SBI* > > ! 
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STjRE(LATTH) ; gENJMP ( 57 ( *UJP* ) , LADDR ) 5 PUTLABEL ( LCIX ) ; 
LC := LC - INTSI^E 
C.ND <*FO«STATEME>jT*) ; 



PROCEDURE WITHSTATEMEfjTl 

var lcp: ctp; lcnti,lcnt2: disprange; 

BEGIN LCNTl := 0; LCNT2 := 0; 
REPEAT 

IF SY = IDE.MT THEN 

BEGIN SEARCHIDCVARS + CFIELD3, LCP ) ; INSYMBOL END 
ELSE BEGIN ERROR(2); LCP := UVARPTR END; 
SELECTOR(FSYS + CCOMMA» DOSY3. LCP) ; 
IF GATTR.TYPTR <> NIL THEN 

IF GATTR.TYPTR~.FORM = RECORDS THEN 
IF TOP < DISPLIMIT THEN 

BEGIN TOP := TOP + l; LCNTl := LCNTl + II 
WITH DISPLAYCTOPD DO 

BEGIN FNAME := GATTR. TYPTR^.FSTFLD END; 
IF GATTR. ACCESS = DRCT THEN 
WITH DISPLAYCTOP3 DO 

BEGIN OCCUR := CREC; CLEV := GATTR. VLEVEL5 

CDSPL := GATTR. DPLMT 
END 
ELSE 

begin loadaddress; gen2 ( 56 ( *str*) , »lc ) ? 
with displayctopd do 

begin occur := vrec ; vdspl := lc end? 
lc := lc + ptrsize; lcnt2 := lcnt2 + ptrsize; 
if lc > lcmax then lcmax := lc 

END 
END 
ELSE ERROR(250) 
ELSE ERROR(140) ; 
TEST := SY <> COMMA; 
IF NOT TEST THEN INSYMBOL 
UNTIL TEST; 
IF SY = DOSY THEN INSYMBOL ELSE ERROR(54)5 

statement(fsys) ; 

top := top - lcntl; lc := lc - lcnt2; 
end uwithstatement*) ; 
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BEGIN (♦STATEMENT*) 

STMTLEV := STMTLEV + 15 
IF SY = INTCONST THEN (*LABEL*) 
BEGIN TTOP := TOP; 

saIHILE DISPLAYCTTOPD.OCCJR <> ELCK DO TTOp := TTOP-1; 
LLP := OISPLAYCTTOPJ.FLABEU 
MILE LLP <> NIL DO 
WITH LLP~ DO 

IF LABVAL = VAL.IVAL THEN 
BEGIN 

IF CODELBP*. DEFINED THEN ERR0RU65); 
PUTLABEL(CODELBP) ! GOTO 1 
END 
ELSE LLP := NEXTLAB! 
ERR0RQ67) J 

1: insymbol; 

if sy = colon then insymbol else error(5) 
end; 

IF DEBUGGING THEN 

BEGIN GENK85(*BPT*).SCREEND0TS+1) ; BPTONLINE := TRUE END? 
IF NOT (SY IN FSYS + CIDENT3) THEN 

BEGIN ERR0R{6); SKIP(FSYS) END? 
IF SY IN STATBEGSYS + CIDENT3 THEN 

BEGIN MARK(HEAP)? (*F0R LABEL CLEANUP*) 
CASE SY OF 

IDENT: BEGIN SEARCHIDtVARS + CFlELD,FUNC,PROCD,LCP) \ 

insymbol; 

if lcp~.klass = proc then call (fsys. lcp) 

else assignment(lcp) 

END; 

BEGIN INSYMBOL 
BEGIN INSYMBOL^ 
BEGIN INSYM30L 
BEGIN INSYM30L 
BEGIN INSYMBOL 
BEGIN INSYMBOL! 
BEGIN INSYM30L< 
BEGIN INSYMBOL 



beginsy: 

gotosy: 

ifsy: 

casesy: 

whilesy: 

repeatsy: 

forsy: 

withsy: 
end; 
release(heap) 



compoundstatement end; 
gotostatement end; 
ifstatement end; 
casestatement end; 
whilestatement end; 
repeatstatement end; 
forstatement end; 
withstatement end 
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IF IC + 100 > MAXCODE THEN 

3EGIM ERR0R(253); IC := EMD; 
IF NOT (SY IN CSEMIC0L0N,ENDSY«ELSESY»UNTILSY3) 

BEGIN ERR0R(6); SKIP(FSYS) END 

END; 

stmtlev := stvtlev - 1 
end (*statement*) ; 



THEN 



PROCEDURE BODY! 

var llci,exitic: ADDRRANGE; lcp: ctp; 

LLP: LABELP; LMIN.LMAX: INTEGER; 
DUMiVlYVAR: ARRAYC0..0] OF INTEGER; 



lop: oprange; 
jtinx: jtabrange; 
(♦for pretty display 



OF STACK AND HEAP*) 



BEGIN 

IF (NOSWAP) AND (STARTINGUP) THEN 
BEGIN 

declarationpart(fsys) { <* bring in declarationpart *) 
exit(bodypart) 5 
end; 
nextjtab := 11 
if noisy then 
begin writeln(output) ; 
if not noswap then (*must 

unitwrite(3,dummyvarc-1600 3.35) 
dummyvarco::=memavail; 

IF DUMMYVARCOD < SMALLESTSPACE THEN SMALLESTSPACE:=DUMMYVARC03; 

if fprocp <> nil then 

writeln(outputtfprocp%name.' c • .dummyvarc 315. * words]*); 
write ( output* »< • »screend0ts:4 1 •>») 
end; 
if fprocp <> nil then 



ADJUST DISPLAY OF STACK AND HEAP*) 



BEGIN 

LLC1 := FPROCP^.LOCALLC; 
WHILE LCP <> NIL DO 
WITH LCP* DO 
BEGIN 

IF IDTYPL <> NIL 



LCP := FPROCP*. NEXT; 



THEN 
IF (KLASS = ACTUALVARS) THEN 

IF (IDTYPE^.FORM > POWER) THEN 
BEGIN LLCl := LLC1 - PTRSIZE; 
GEN2(50(*LDA*)»0.VADDR); 
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GEN2(54(*L0D*) tOtLLCD ; 
IF PAOFCHARCIDTYPE) THEN 
WITH IDTYPE~ DO 

IF AlSSTRNG THEN GEN1 ( 42 ( *SAS* ) , MAXLENG ) 
ELSE 

IF INXTYPE <> NIL THEN 

BEGIN GETBOUNDS(INXTYPE,LMIN«LMAX) 5 

GEN1(40(*M0V*) » (LMAX-LMIN+1+1) DIV 2) 
END 
ELSE 
ELSE GENK40(*MOV*)»IDTYPE~.SIZE) 
END 
ELSE LLC1 := LLC1 - IDTYPE^.SIZE 
ELSE 

IF KLASS a FORMALVARS THEN LLCl := LLC1 - PTRSI2EJ 
LCP := NEXT 

end; 
end; 
startdots := screendots; 
lcmax := LC! 

LLP := DISPLAYCTOP3.FLABEL; 
WHILE LLP <> NIL DO 

begin genlabehllp^.codelbp) ; 

llp := llp^.nextlab 
end; 
if not inmodule then 

IF LEVEL = 1 THEN 

BEGIN LCP := usinglist; 

WHILE LCP <> NIL DO 
BEGIN 

IF LCP^.SEGID >= THEN 

BEGIN GENLDC(LCP A .SEGID) ; GEN1 ( 30 ( *CSP* ) t 21 ( *GETSEG* ) ) END; 
LCP := LCP". NEXT 

end; 

IF USERINFO. STUPID THEN 

GEN2(77(*CXP*) »6(*T'JRTLE*) «1<*INIT*)) 

END; 
LCP := DISPLAYCTOP3.FFILE; 
WHILE LCP <> NIL DO 
WITH LCP'MDTYPE* DO 

BEGIN 
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THEN GENLDC(O) 



GE.N2(50(*LDA*) «0. VADDft) ; 
GEN2(50(*LOA*) » t VAQDR+FILESIZE ) 
IF FILTYPE = NIL THEN GENLDC(-l) 
ELSE 

IF IDTYPE = INTRACTVPTR 
ELSE 

IF FILTYPE = CHARPTR THEN GENLDC(-2) 
ELSE GENLDC(FILTYPE A .SIZE); 
GEN2(77(*CXP*) .0(*SYS*> ,3(*FINIT*) ) ; 
LCP := NEXT 
END; 
IF (LEVEL = 1) AND NOT SYSCOMP THEN 

GEN1(85(*BPT*) » ScREENDOTS+1 ) ; 
REPEAT 

REPEAT STATEMENT(FSYS + CSEMlCOLONiENDSYD) 

UNTIL NOT (SY IN STATBEGSYSJ; 

TEST := SY <> SEMICOLON! 

IF NOT TEST THEN INSYMBOL 
UNTIL TEST; 
IF SY = ENDSY THEN INSYMBOL ELSE ERR0RM3): 

exitic := ic; 

LCP := DISPLAYCTOPU.FFILE; 
WHILE LCP <> NIL DO 
WITH LCP A DO 
BEGIN 

GEN2(50(*LDA*) tOiVADDR) ; 

GENLDC(O); GEN2(77(*CXP*),0(*SYS*),6(*FCLOSE*)); 
LCP := NEXT 

end; 

IF NOT INMODULE THEN 
IF LEVEL = 1 THEN 
BEGIN 

LCP .'= USINGLIST; 
WHILE LCP <> NIL DO 
BEGIN 

IF LCP'.SEGID >= THEN 

BEGIN GENLDC(LCP-.SEGID); GEN1 < 30 ( *CSP*) t22 < *RELSEG* ) ) 
LCP := LCP". NEXT '»«i*KLLJ>tb*M 

END 

end; 

IF FPRDCP = NIL THEN GENO ( 86 ( *XIT*) ) 



end; 
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432 



4296 13 57:i 64 ELSE 

4297 13 57:2 63 3EGIM 

4298 13 57!3 63 IF FPROCP" . PFlEV = THEN LOP := 65(*RBP*) 

4299 13 57:o 77 ELSE LOP := 45(*RNP*)5 

4300 13 57:3 85 IF FPROCP~.IDTYPL = NIL THEN GEN1(LOP«0) 

4301 13 57:3 95 ELSE GEN1 t LOP , FPRQCP" . IDT YPE~ . SIZE ) 

4302 13 57:2 05 ENDS 

4303 13 57:i 07 LLP := DlSPLAYC TOP3.FLABEL 5 (* CHECK UNDEFINED LABELS *) 

4304 13 57:i 15 WHILE LLP <> NIL DO 

4305 13 57:2 20 WITH LLP* » C0DEL3P~ DO 

4306 13 57:3 27 BEGIN 

4307 13 57:4 27 IF NOT DEFINED THEN 

4308 13 57:5 32 IF REFLIST <> MAXADDR THEN ERRQRU68); 

4309 13 57:4 46 LLP := NEXTLAB 

4310 13 57:3 46 END; 

4311 13 57:i 52 JTINX := NEXTJTAB - ll 

4312 13 57:i 59 IF ODO(lC) THEN IC := IC + 1? 

4313 13 57:i 67 WHILE JTINX > DO 

4314 13 5712 72 BEGIN GENWORDt IC-JTABC JTINXD) ; JTINX := JTINX-1 END; 

4315 13 57:i 91 IF FPROCP = NIL THEN 

4316 13 57:2 98 BEGIN GENWORDt (LCMAX-LCAFTERMARKSTACK ) *2) 5 GENWORD(O) END 

4317 13 57:i 11 ELSE 

4318 13 57:2 13 WITH fPROCP" DO 

4319 13 57:3 18 BEGIN GENWORD( (LCMAX-L0CALLC)*2) 5 

4320 13 57!4 29 GENWORDt (L0CALLC-LCAFTERMARKSTACK)*2) 

4321 13 5713 36 END; 

4322 13 57:i 39 GENWORDt IC-EXITIC ) ; GENWORD(IC); 

4323 13 57:i 49 GEN3YTE ( CURPROC ) 5 GENBYTE { LEVEL-1 ) 5 

4324 13 57:i 61 IF NOT cODEINSEG THEN 

4325 13 57:2 66 BEGIN CODEINSEG := TRUE; 

4326 13 57:3 69 SEGTABLECSEGD.DlSKADDR := CURBLK 

4327 13 57:2 77 END! 

4328 13 57:i 61 WRITECODE(FALSE) J 

4329 13 57:i 65 SEGINX := SEGINX + IC; 

4330 13 57:i 91 PR0CTA3LECCURPR0CJ := SEGINX - 2 

4331 13 5710 00 END <*BODY*> 5 

4332 13 57:0 42 

4333 13 1:0 BEGIN (*30DYPART*) 

4334 13 111 BODY 

4335 13 i:0 END 5 

4336 13 i:0 14 



4337 13 i:n m 

Hit H y ,Q 1<+ ( * $I «5:30DYPART.E.TEXT*) 

u^o }t 14 ( * $I C -'JNITPART.TEXT*) 

'+339 13 i:o m 

434Q 13 i:o in 

<+34i i3 i: m 



4342 



13 i:a ii |********************************^ 



4344 li l'n Ja * C0PYRIGHT ( L979 REGENTS OF THE UNIVERSITY OF CALIFORNIA *\ 

till 13 J:J JJ * PERMISSION TO COPY OR DISTRIBUTE THIS SOFTWARE OR DOcSSc"' * 

4346 ll }:S 14 * TA I I0N IN HARD ° R S0FT C0PY G *^TED ONLY BY WRITTEN LICENSE * 

*347 13 lio £? {J 0BTAIN ED FROM THE INSTITUTE FOR INFORMATION SYSTEMS. *J 

till ll iId 2 SE ?ype T PR0CEDURE wr itelinkerinfo(decstuff:boolean); 

4352 14 i • "i o 

«53 14 IJ5 2 LITYPES = ( ^ MAR n;c 0D S U ^' GL0BREF ' PUBBLIC » PRlV ^TE,C0NNSTANT,GL0BDEF. 

4354 i4 Jo 1 ^^def,constdef,extproc.extfunc.ssepproc,ssepfunc, 

43S S 5 1a i.r% -> J>t.rrREF«SLPFREF) i 

4356 il ^n 5 OPFORMAT = (WORD, BYTE. BI6)| 

4357 JI J:S * LIENTRY = RECORD 

till JJ J:° f liname: ALPHA; 

4359 14 J.'n P CASE LITYPE: LITYPES OF 

W60 14 I- I MODDULE, 

4361 14 l'n I PUBBLIC, 

4362 14 l'n 2 PRIVATE, 

4363 14 l'n l SEPPREF, 

4364 14 l'n 2 SEPFREF: (FORMAT: OPFORMAT; 

4365 14 l'n 2 NREFS: INTEGER; 

4366 14 I'D 2 ^ NWORDS: INTEGER); 

4367 14 in 2 CONSTDEF: (CONSTANT: INTEGER); 

4368 14 111 2 St S? E mn.«r <BASEOFFSET: INTEGER,; 

4369 14 l'n % EXTPROCEXTFUNC, 

4370 14 I'D 2 SSEPPROC.SSEPFUNCMPROCNUM: INTEGER; 

4371 14 I'D 2 MPARAMS: INTEGER; 

4372 14 i: 2 riun. RANGE: ^INTEGER, 

4373 14 i: 2 

4375 14 J'D f VAR rv P *«5 P: CTP ' CURRENTBLOCK : INTEGER; I: NONRESIDENT; 

4376 14 J*n ,? EXTNAME: ALPHA; FIC: ADDRRANGE; 
<+376 14 l.D 11 LIREC: LIENTRY; 
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PROCEDURE GETREFSdD.LENGTH: INTEGER); 

var ;_ic: aqurrange; j, max, blockcount, count: integer; 

procedure getnextblock; 

begin 
currentblock := currentblock + 1; 
if currentblock > refblk then currentblock := 05 
if 8lockread(reffile»reflist'm. currentblock) <> 1 then; 

end (*getnext3l0ck*) ; 

begin (*getrefs*) 
if (nrefs = 1) and (refblk = 0) then exit(getrefs ) ; 
count := o; 

FOR BLOCKCOUNT := TO REFBLK DO 
BEGIN 

IF CURRENTBLOCK < REFBLK THEN MAX := REFSPERBLK ELSE MAX := NREFS-U 
FOR J := 1 TO MAX DO 

IF ID = REFLIST^CJJ.KEY THEN 

BEGIN GENWORD(REFLIST^CJD. OFFSET) ; COUNT := COUNT + 1 END! 
IF BLOCKCOUNT < REFBLK THEN GETNEXTBLOCK; 
END; 
Lie := ic; ic := fic; genword(COUNT) ; ic := Lie; 

(♦NOW FILL REST OF 8-WORD RECORD*) 

FOR J := 1 TO ((8 " (COUNT MOD 8)) MOD 8) DO GENWORD(O) 
END (* GETREFS *) ; 

PROCEDURE GLOBALSEARCHtFCP: CTP); 
VAR NEEDEDBYLINKER: BOOLEAN; 

BEGIN 

NEEDEDBYLINKER := TRUE! 
WITH LlRECFCP* DO 
CASE KLASS OF 

TYPES: NEEDEDBYLINKER := FALSE; 

KONST: IF (IDTYPE^.SIZE = 1) AND NOT INMODULE THEN 
BEGIN LITYPE := CONSTDEF5 
CONSTANT := VALUES. IVAL 
END 
ELSE NEEDEDBYLINKER := FALSE; 
FQRMALVARSt 
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PUBBLIC 



:= privvate; 
= formalvars then 

:= PTRSIZE 

:= IDTYPE^.SIZE 



PUBLICDEF; 
VADDR 



ACTUALVARS: 
BEGIN 

IF INMODULE THEN 
dEGliM 

IF PUBLIC THEN 
BEGIN LITYPE 

NWORDS := 
END 
ELSE 

BEGIN LITYPE ; 
IF KLASS 
NWORDS 
ELSE 

NWORDS 
END! 
FORMAT := BIG 
END 
ELSE 

BEGIN LITYPE := 
BASEOFFSET := 
END 
END5 

field: neededbylinker := false; 

PROC, 

FUNC: BEGIN 

IF PFDECKIND r DECLARED THEN 
IF PFKIND = ACTUAL THEN 
IF KLASS = PROC THEN 
IF EXTURNAL THEN 

IF SEPPROC THEN LITYPE := SEPPREF 
ELSE LITYPE := EXTPROC 
ELSE 

IF SEPPROC THEN 

LITYPE := SSEPPROC 
ELSE NEEDEDBYLINKER .-= FALSE 
ELSE UKLASS = FUNC*) 
IF EXTURNAL THEN 

IF SEPPROC THEN LITYPE := SEPFREF 
ELSE LITYPE := EXTFUNC 
ELSE 

IF SEPPROC THEN 



43; 
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module: 



hty°e := ssepfunc 
else neededbylinker '.= false 
elsl neededbylinker := false 
else neededbylinker := false; 
if neededbylinker then 

BEGIN 

LCP := NEXT; NPARAMS := 0! 
WHILE LCP <> NIL DO 
BEGIN 

WITH LCP A DO 

IF KLASS = FORMALVARS THEN 

NPARAMS := NPARAMS + PTRSIZE 
ELSE 

IF KLASS = ACTUALVARS THEN 

IF IDTYPE^.FORM <= POWER THEN 

NPARAMS := NPARAMS + IDTYPE^.SIZE 
ELSE NPARAMS := NPARAMS + PTRSIZE? 
LCP := LCP A .NEXT 
END? 
IF LITYPE IN CSEPPREF«SEPFREF3 THEN 

BEGIN FORMAT := BYTE; NWOROS := NPARAMS END 
ELSE 

BEGIN PROCNUM := PFNAME? RANGE := NIL END 
END 
END (*PROC»FUNC*) ; 
BEGIN 

THEN NEEDEDBYLINKER := FALSE 



IF NOT INMODULE 
ELSE 

BEGIN LITYPE 
END 
END (*CASEiWITH*> 5 
IF NEEDEDBYLINKER THEN 

IF SEGTABLECSEGD.SEGKIND = 2 
WITH LIREC DO 

IF (LITYPE = CONSTDEF) OR 
NEEDEDBYLINKER := FALSE; 
IF NEEDEDBYLINKER THEN 
WITH LIREC DO 

3EGIN LINAME := FCP^.NAME; 

FOR LGTH := 1 TO 8 DO GENBYTE t ORD{ LINAMECLGTH3) ) 
GENWORD(ORDILITYPE) ) ; 



= MODDULE; NWORDS := 0? FORMAT := BYTE END 

(♦SEGPROC*) THEN 
(LITYPE = PUBLICDEF) THEN 



4500 


14 


4J4 


o2 


4501 


14 


4:^ 


57 


4502 


14 


4:4 


57 


4503 


14 


4:4 


37 


4504 


14 


4:4 


57 


4505 


14 


4:6 


D7 


4506 


14 


4:6 


63 


4507 


14 


4:s 


71 


4508 


14 


4:6 


77 


4509 


14 


4:6 


68 


4510 


14 


4:7 


92 


4511 


14 


4:a 


02 


4512 


14 


4:7 


07 


4513 


14 


4:5 


21 


4514 


14 


4:4 


23 


4515 


14 


4:4 


39 


4516 


14 


4:4 


55 


4517 


14 


4:6 


55 


4518 


14 


4:& 


61 


4519 


14 


4:6 


67 


4520 


14 


4:5 


70 


4521 


14 


4:4 


75 


4522 


14 


4:6 


75 


4523 


14 


4:6 


81 


4524 


14 


4:6 


87 


4525 


14 


4:6 


93 


4526 


14 


4:7 


05 


4527 


14 


4:6 


24 


4528 


14 


4:7 


31 


4529 


14 


4:6 


32 


4530 


14 


4:6 


41 


4531 


14 


4:6 


45 


4532 


14 


4:6 


59 


4533 


14 


4:5 


64 


4534 


14 


4:4 


66 


4535 


14 


4:3 


04 


4536 


14 


4:1 


04 


4537 


14 


4:1 


18 


4538 


14 


4:1 


18 


4539 


14 


4:1 


28 


4540 


14 


4:1 


36 



CASE LITYPE OF 
MODuULE. 
PUBBulC, 
PRIMATE, 
SCPPREF.SEPFHEF: 



= MODDULE THEN GETREFS(FCP A ,SEGID. 1 ) 



THEN 



constdef: begin 
publicdef: begin 
extproc.extfunc: 



ssepprocssepfunc; 



IF 



ENDUCASE*) 
END(*WITH*) ; 
IC >= 1024 THEN 



BEGIN 

GE(\JWORD(ORD(FORMAT) ) ; 
FIC := IC; GENWORD(O); 
SENWORD(NWORDS) 5 
IF LITYPE 
ELSE 
IF LITYPE IN CSEPPREF,SEPFREF3 
GETREFS(-FCP".PFNAMEtl) 

ELSE GETREFS(FCP A .VADDR + 32 t FCP*. IDTYPE A .SIZE) ; 

END; ' 

GENWORO(CONSTANT)5 GENWORD(O); GENWORD(O) END? 
GENWORD(BASEOFFSET); GENWORD(O); GENWORD(O) END; 
BEGIN 

GENWORD(PROCNUM); 

GENWORD(NPARAMS); 

GENWORD(ORD(RANGE)) 
END? 
BEGIN 

GENWORD(PROCNUM); 

GENWORD(NPARAMS)! 

GENWORD<ORD(RANGE>) 5 

FOR LGTH := 1 TO 8 DO 

GENBYTE(ORD(LINAMECLGTH3) ) ; 
IF LITYPE = SSEPPROC THEN 

GENWORD(ORD(SEPPREF) ) 
ELSE GENWORD(ORD(SEPFREF>>; 
GENWORD(ORD(BYTE)) ; 

FIC := IC; GENWORD(O); GENWORD(NPARAMS) ; 
GETREFS(-PROCNUMtl) 
END 



BEGIN WRITECODE(FALSE); IC := END; 



IF FCP^.LLINK <> 
IF FCP^.RLINK <> 



NIL THEN GLOBALSEARCH(FCP^.LLINK); 
NIL THEN GLOBALSEARCH(FCP~.RLINK) 
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END (*3L03ALSEARCH*) ! 
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..EG IN 
IC 
IF 

IF 



IF 



D 
BE 



EN 
(*NO 
WITH 

FO 



<**RlTELINKERlNFO*) 

= 0; 

ODEINSEG THEN ERR0R(399); 

NMODULE THEN 

CURRENT3L0CK := REFBLKI 

ECSTUFF THEN (*SKIP IF NO DECLARATIONPART 

GIN FCP t= DISPLAYCGLEV3.FMAME; 

IF FCP <> NIL THEN GLOBALSEARCH (FCP ) 

DJ 

W DO NONRESIDENT PROCS*) 

LIREC 00 
R I := SEEK TO DECOPS DO 
IF PFNUMOFCI3 <> THEN 
3EGIN 



LINKER INFO*) 



CASE I OF 

seek: 

freadreal: 
fwritereal: 
freaddec: 

FWRITEDEc: 



decops: 
end; 

FOR LGTH 



BEGIN 
BEGIN 
BEGIN 
BEGIN 

BEGIN 

BEGIN 



LINAME := 'FSEEK * ? NPARAMS := 2 END; 

LINAME := »FREADREA»5 NPARAMS := 2 END; 

LINAME := •FWRITEREM NPARAMS := 5 END; 

LINAME := 'FREADDEC'; NPARAMS := 3 END; 
LINAME := 'FWRITEDE'; 

NPARAMS := 2+DECSlZE(MAXDEO END; 

LINAME := «DECOPS M NPARAMS := END; 



:= 1 



(* N 

FOR 

GENW 

GENW 



TO 8 DO GENBYTE(ORD(LlNAMECLGTHD)) ; 
IF SEPPROC THEN 

BEGIN GENWORD(ORD(SEPPREF) ) ! 

GEMWORD(ORD(BYTE) ) ? FIC := IC; GENWORD(O); GENWORD( NPARAMS) ; 
GETREFS ( -PFNUMOFC 13,1) 
END 
ELSE 

begin genwurd(ord(extproc) ) \ 

genwordi pfnumofc id) 5 genword (nparams) 5 genword(o) 
end; 
pfnumofc 1 1 := 0; 
enO; 
ow do eofmark end-record*) 
lgth := 1 to 8 do genbyte ( ord ( • •)); 
ord(ORd<eofmark) ) ; genword<lcmax) ; 
ord(o) jgenword(o) • 
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WRITECODE(TRUE) ? 
CLINKERINFO := FALSE? 

IF DEC3TUFF THEM DLINKEKINFO := FALSE 
END (*WRiTELlNKErtINFO*> i 

SEGMENT PROCEDURE UNITPART < FSYS : SETOFSYS); 
VAR UMARKP: TESTP; 

PROCEDURE OPENREFFILE; 
BEGIN 

REWRITE(REFFILE,»*SYSTEM,INF0C*3»); 
IF IORESULT <> THEN ERROR(402) 
END (* OPENREFFILE *> ; 

PROCEDURE UNITDECLARATIONiFSYS: SETOFSYS; VAR UMARKPITESTP) ; 

var lcp: ctp; found: boolean; llexstk: lexstkrec; 

BEGIN 

IF INMODULE THEN ERR0R(182 (* NESTED MODULES NOT ALLOWED *)); 
IF CODEINSEG THEN 

BEGIN ERROR(399)5 SEGINX := 05 CURBYTE := END; 
WITH LLEXSTK DO 
BEGIN 

DOLDTOP .*= TOPS 
DOLDLEV := LEVEL; 

poldproc := curproc; 
soldproc := nextproc; 
doldseg := segj 
dllc := lc; 

PREVLEXSTACKP := TOS 

end; 
seg := nextseg; 

NEXTSEG 1= NEXTSEG + i; 

if nextseg > maxseg then error(250); 

nextproc := 1; 

lc := lcaftermarkstack; 

publicprocs := false; 

inmodule := true; 

INSYM30L; 

IF SY <> IDENT THEN ERR0R(2) 

ELSE 

BEGIN FOUND := FALSE; 
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:= modptr; 



lcp := modptr; 

/JrllLE (LCP <> NIL) AND NOT FOUND DO 

IF LCP^.NA^E <> ID THEN LCP := LCP^.NEXT 
ELSE BEGIN FOUND := TRUE? ERROR(lOl) ENOi 
IF NOT FOUND THEN 

BEGIN NEW(LCP»MODULE) ; 
WITH LCP- DO 

BEGIN NAME := ID? IDTYPE := NIL; NEXT 

klass 5= module; segid := seg 
end; 
modptr := lcp 
end; 
end; 

SEGTABLECSEG3.SEGNAME := ID; 
MARK(UMARKP) ; 
NEW(REFLIST) ! 
NEW(TOS); 
TOS~ := LLEXSTK; 
LEVEL := 1$ 

IF TOP < DISPLIMIT THEN 
BEGIN TOP := TOP + li 
WITH DISPLAYCTOP3 DO 

BEGIN FNAME := NIL? FFILE := NIL? FLABEL := NIL; OCCUR := BLCK END; 
IF LCP <> NIL THEN ENTERID(LCP) 
END 

else error(250) ; 
insymbOLi 

IF SY = SEMICOLON THEN INSYMBOL ELSE ERR0RU4) 
END (*UNITDECLARATI0N*) 5 

BEGIN (*UNITPART*) 
OPENREFFILES 
REPEAT 

reset(REFFile); nrefs := 1; refblk := o; 
if (sy = separatsy) then 
begin sepproc := true; 
insymbol! if sy <> unitsy then err0r(24) 

END 
ELSE 

sepproc := false; 

UNITDECLARATION(FSYSiUMARKP) ; 
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IF SEPPROC THEN SEGTA3LEC SEG J.SEGKINQ := 4 ELSE SEGTABLEC SEGD.SEGKIND := 3: 
SEGTABLECSEG3.TEXTADDR := CUR3LKJ 
WRITETEXT; 

IF SY = INTERSY THEN INSYMBQL 
ELSE ERR0R(22) ; 
ININTERFACE := TRUE; 
OECLARATIONPART(FSYS) ; 
IF PUBLICPROCS THEN 
BEGIN 

ININTERFACE ;= FALSE; 

IF SY <> IMPLESY THEN BEGIN ERROR(23); SKlPtFSYS - STATBEGSYS) END 

ELSE insymbol; 

BLOCK(FSYS - CSEPARATSY 1 UNITSY* INTERSY. IMPLESY3) ; 
IF REFBLK > THEN 

IF BLOCKWRlTE(REFFlLEtREFLIST^,l, REFBLK) <> 1 THEN ERR0R(402}; 
WRITELINKERINFO(TRUE) ; 
END 
ELSE 

BEGIN DLINKERINFO := FALSE; 
WITH SEGTABLECSEG3 DO 

BEGIN CODELENG := 0; DISKADDR :=CURBLK; SEGKlND := END! 
END! 

sepproc 1= false; (*false whenever not inmodule*) 

inmodule := false; 

if sy = endsy then insymbol 

else begin err0ru3); sklptfsys) end; 

if sy <> period then 

if sy = semicolon then insymbol 

else err0ru4) ; 
with tos* do 

3EGIN 

TOP := DOLDTOP; 

LEVEL := DOLDLEV; 

CURPROC := PULDPROC; 

NEXTPROC := S0LDPR0C5 

SEG := doldseg; 

lc := DLLC; 
END". 

TQS := tos~.prevlexstackp; 

RELEASE(JMARKP) 
UNTIL NOT (SY IN C UNITSY , SEPARATS Y 1 ) i 
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(*$I »5:UNlTPART.TEXT*) 

(*$I «5:procs.a.text*) 



49 CLOSE(REFFILE) 

56 END (+UNITPART*) ; 
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(* 
(* 
(* 
(* 
(* 
(* 



COPYRIGHT (C) L979 REGENTS OF THE UNIVERSITY OF CALIFORNIA. 
PERMISSION TO COPY OR DISTRIBUTE THIS SOFTWARE OR DOCUMEN- 
TATION IN HARD OR SOFT COPY GRANTED ONLY BY WRITTEN LICENSE 
OBTAINED FROM THE INSTITUTE FOR INFORMATION SYSTEMS. 



*) 
*) 
*) 
*) 
*) 
*) 



(♦♦♦a!:**************************************************************) 



PROCEDURE ERROR<*ERRORNUM: INTEGER*); 
VAR CH; CHAR; ERRSTART: INTEGER; 

A: PACKED ARRAY CO. .1793 OF CHAR; 
BEGIN 

WITH USERINFO DO 

3 IF (ERRSYM <> SYMCURSOR) OR (ERRBLK <> SYMBLK) THEN 
17 BEGIN ERRBLK := SYMBLK; 
24 ERRSYM := SYMCURSOR; ERRNUM 1= ERRORNUM5 

36 IF STUPID THEN CH := »E» 
41 ELSE 

46 BEGIN 

46 IF NOISY THEN WRITELN (OUTPUT ) 

56 ELSE 

58 IF LIST AND (ERRORNUM <= 400) THEN 

68 EXIT(ERROR); 

72 IF LINESTART = THEN 

78 WRITE(OUTPUT»SYMBUFP A :SYMCURSOR) 

69 ELSE 

91 BEGIN 

91 ERRSTAKT := SCAN ( - ( LINESTART-1 ) »=CHR ( EOL ) » 

93 SYM3UFP*C LI NEST ART-2D)+LI NEST ART-l; 

13 MOVELEFT(SYM3UFP A CERRSTART3.AC0D,SYMCURSOR-ERRSTART) ; 

23 WRITE (OUTPUT. AISYVICURSOR-ERRSTART) 

37 end; 

37 *RITELN(OUTPUT» ' <<<<•); 



4745 

4746 

'♦747 

4748 

4749 

4750 

4751 

4752 

4753 

4754 

4755 

4756 

4757 

4758 

4759 

4760 

4761 

4762 

4763 

4764 

4765 

4^766 

4767 

4768 

4769 

4770 

4771 

4772 

4773 

4774 

4775 

4776 

4777 

4778 

4779 

4780 

4781 

4782 

4783 

4784 

4785 



1C 

1G 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 



• o 
IS 

;i 

• o 

• o 

16 

:5 
in 
:s 

:4 
:5 

14 



2:4 
2:5 
2:3 
2:0 
2:0 
3:d 
3:0 
3:1 
3:2 
3:3 
3:4 
3:5 
3:6 
3:4 
3:3 
3:4 
3:5 
3:6 
3:3 
3:4 
3:5 
3:5 
3:4 
3:2 
3:1 

512. 
3:3 

3:4 
3:5 



53 

16 

20 

70 

78 

86 

02 

05 

14 

27 

38 

48 

54 

58 

83 

83 

02 

1 



6 

10 

10 

17 

17 

34 

34 

37 

39 

46 

64 

67 

72 

72 

82 

82 

87 

87 

92 

92 

96 

14 



END 



WRlTfT(OUTPUT, 'LINE 
IF NOISY THEN 

WrUTE(OUl'PUTi ' <SP>( CONTINUE ) » 
WRITE(0UTPUT,CHR(7) ) ; 
REPEAT READ(KEYSOARDtCH) 
UNTIL (CH = ' ' ) OR (CM = 'E') OR 
END; 
IF (CH = 'EM OR (CH = »E») THEN 

BEGIN ERRBLK := SYMBLK-2; EXIT ( PASCALCOMPILER ) 
IF (ERRORNUM > 400) OR (CH = CHR(27)) THEN 

BEGIN ERRBLK := 0; EXIT ( PASCALCOMPILER ) END; 
WRITELN(OUTPUT) « 
IF NOISY THEN 

WRITE (OUTPUT 1 •< • f SCREENDOTS: 4, •>' ) 
END 
(♦ERROR*) ; 



* tSCREENDOTSt • ♦ ERROR •. ERRORNUM : »':») ; 
<ESCXTERMINATE) t E(DITM; 

(CH = »E») OR (CH = ALTMODE) 

end; 



PROCEDURE GETNEXTPAGE5 

BEGIN SYMCURSOR := 0; LINESTART := 0« 
IF USING THEN 
BEGIN 

IF USEFILE = WORKCODE THEN 
BEGIN 

IF BL0CKREAD(USERINFQ.W0RKC0DE*,SYMBUFP*.2,SYMBLK) <> 2 THEN 
USING := FALSE 

END 
ELSE 

if usefile = syslibrary then 
if bl0ckread<llbraryisymbufp%2tsymblk) <> 2 then 
using := false; 
if not using then 

BEGIN 

SYMBLK := PREVSYMBLK5 SYMCURSOR ;= PREVSYMCURSOR 5 
LINESTART ;r PREVLINESTART 
END 
END? 
IF NOT USING THEN 
BEGIN 

IF INCLUDING THEN 

IF BL0CKREAD(INCLFILE,SYMBUFP'S2, SYMBLK) <> 2 THEN 
BEGIN CLOSE(INCLFILE) ; INCLUDING := FALSE; 
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144 

symblk := oldsymblk; symcursor := oldsymcursor; 
linestaiu '-- cldlinestart 

EN J 
END ; 
IF NOT (INCLUDING OR USING) THEN 

IF 3lQCKREAD(USERINF0.W0RKSYM'NSYMBUFP' n i2, SYMBLK) <> 2 THEN 
ERROR(401) ; 
IF SYMCURSOR = THEN 
BEGIN 

if inmodule then 

if ininterface and not using then writetext; 
if sym3ufp~c0j = chr < 16< *dle* ) ) then 
symcursor := 2 
end; 
symblk := symblk+2 
end ugetnextpage*) ; 

procedure printline; 

var dorlevtstarorc: char; leng: integer; 
a! packed array co. .993 of char; 
begin starorc := • :•; 

if dp then dorlev •= »d* 

else dorlev := chr ( (begstmtlev mod 10) + ord('0*)>; 

if bptonline then starorc := »*•; 

write(lp«screendots:6,seg:4,curproc:5, 

STARORC, dorlev*lineinfo:6.» m; 

leng := symcursor-linestart; 

if leng > 100 then leng := 100; 

moveleft<symbufp~clinestart;],a,leng) ; 

if aco] = chr(16(*dle*)) then 

BEGIN 

IF AC1H > • • THEN 

^RlTEtLP,' MORDiACiaj-ORDC *)); 
LENG := LENG-2; 
M0VELEFT(AC:2J,A»LENG) 

end; 
acleng-ld := chr(eol); (*just to make sure*) 

hrite<lp«a:leng) ; 
with userinfo do 

IF (EKRBlK = SYMBLK) AND (ERRSYM > LIMESTART) THEN 



4827 10 His 3 WRIT£LN(LP. •>>>>>> ERROR s • .ERRNUM) 

^823 IG 4:o 52 END ( *PR\ NTLINE* ) ; 

4629 13 i+:q 64 (*$I-*) 

<+830 10 410 64 

4831 13 5:0 1 PROCEDURE ENTERIC (*FCP: CTP*); 

4832 10 5!D 2 VAR LCp,LCP1: CTP; i: INTEGER; 

4833 10 5:0 BEGIN LCP := DISPLA YC TOP3. FNAME ; 

4834 10 511 3 IF LCP = NIL THEN DlSPLAYC ToPD. FNAME := FCP 

4835 10 5!1 18 ELSE 

483S 10 s: 2 22 BEGIN I := TREESEARCH ( LCP , LCPl , FCP A . NAME ) ; 

4837 10 5!3 30 WHILE I = DO 

4838 10 5:4 35 3E GIN ERROR(lOl); 

4839 10 5:5 38 IF LCPl^.RLlNK = NIL THEN I := 1 

???? J° ^i 5 Tl ELSE I := TREESEARCH(LCPl-.RLlNK,LCPltFCP*.NAME) 

4-841 10 5.4 56 enO; 

u«u* J2 III 6 ° IF I = 1 THEN LCP1-.RLINK := FCP ELSE LCP1-.LLINK := FCP 

4843 10 5:2 75 end; 

4844 10 5:i 77 FCP-.LLINK := NIL; FCP-.RLlNK := NIL 

4845 10 510 85 END UENTERID*) ? 

4846 10 5:0 02 

J!JI ^° 6: ° X pR0CE DURE INSYMBOL; (* COMPILER VERSION 3.4 06-NOV-76 *) 

4848 10 6:D 1 LABEL 1 ; 

4849 10 6:d 1 var lvp: csp; x: integer; 

4850 10 6:d 3 

4851 10 2i:D 1 PROCEDURE CHECKEND; 

4852 10 2i:o BEGIN (* CHECKS FOR THE END OF THE PAGE *) 

4853 10 2l:i SCREENDOTS := SCREENDOTS+l; 

4854 10 2i:i 6 SYMCURSOR .*= SYMCURSOR + 1? 

4855 10 2i:i 11 IF NOISY THEN 

4856 10 21:2 15 BEGIN WRITEtOUTPUT . • . • ) ; 

4857 10 21:3 23 IF ( SCREENDOTS-STARTDOTS) MOD 50 = THEN 

4858 10 21:4 34 3E GIN WRITELN ( OUTPUT ) ; 

4859 10 21:5 40 WRITE(0UTPUT« , <».SCREEND0TS:4»t>t) 

4860 10 2H4 65 E ND 

4861 10 21:2 65 END; 

4862 10 2i:i 65 IF LIST THEN PRINTLINE? 

4863 10 21U 71 BPTONLINE := FALSE; 

4364 10 2i:i 74 IF SYMBUFP^C SYMCURSOR 3=CHR ( ) THEN GETNEXTPAGE 

4865 10 2l:i 81 ELSE LinESTART := SYMCURSOR; 



IF SYMBUFP-CSYMCURSORH = CHR(12(*FF*)> THEN SYMCURSOR;=SYMCURSOR+l 5 



4866 10 2i:i 88 

4867 10 2i:i 00 IF SYMBUFP*CSYMCURSOR3 = CHR < 16 ( *DLE*) ) ' THEN 

445 



'4888 

4869 

4370 

4671 

4872 

4873 

4874 

4875 

4876 

4877 

4878 

4879 

4880 

4881 

4882 

4883 

4884 

4885 

4886 

4887 

4888 

4889 

4890 

4891 

4892 

4893 

4894 

4895 

4896 

4897 

4898 

4899 

4900 

4901 

4902 

4903 

4904 

4905 

4906 

4907 

4908 



10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 

10 



21:2 
21:1 
21:2 
21:3 



21 

21 

21 

21 

21 

22 

22:0 

22:0 

2350 

23:d 

23:0 

23:1 

23:1 

23:1 

23:1 

23:0 

23:0 

22:0 

22:1 

22:1 

22:2 

22:3 

22:4 

22:4 

22:4 

22:4 

22:5 

22:6 

22:5 

22:4 

22:4 

22:6 

22:6 

22:5 

22:4 

22:4 

22:4 



j7 
8 
14 
14 
26 
o5 
38 
47 
62 
1 
2 
26 
1 
3 

5 
17 
21 
28 
31 
48 


5 
12 
21 
21 
28 
35 
42 
51 
57 
58 
62 
65 
65 
76 
92 
94 
01 
3 



SYMCJRSOR : 
ELSE 
BEGIN 

SYMCURSOR 

SYMCURSOR 

end; 
if dp then lineinfo 
end; 



= SYMCUKSOR+2 



44n 



= SYMCURSOR + SCAN(80»<>CHR(9)tSYMBUFP A CSYI« , CURSORD) 
= SYMCURSOR+SCAN(80t<>» » ♦ SYMBUFPT SYMCURSOR 1 ) 



:= LC ELSE LINEINFO := IC 



procedure commenter( stopper: char); 
var ch.swtoel: char; ltitle: stringc40]; 

procedure scanstring(var strgj string; maxleng: integer); 

var leng: integer; 
begin symcursor := symcursor+2; 

leng := scan(maxlengf=stoppertsymbufp a csymcursor3) ? 

strgc03 *.= chr(leng) ; 

MOVElEFT(SYMBUFP a C SYMCURSOR D,STRGC 13, LENG); 
SYMCURSOR := SYMCURSOR+LENG+1 
END (+SCANSTRING*) ; 

BEGIN 

SYMCURSOR != SYMCURSOR+i; (* POINT TO THE FIRST CH PAST "(*" *) 
IF SYM3UFP A CSYMCURS0R3=«$' THEN 

IF SYM8UFP A CSY^CURS0R+13 <> STOPPER THEN 
REPEAT 

ch := symbufp^csymcursor+id; 

sw := symbufp' v csymcurs0r+23; 

del := symbufp a csymcursor+3d5 

if (sw = •»•) or (sw = stopper) then 

begin del := sw; sw := »+*? 
symcursor := symcursor-1 

end; 

CASE CH OF . 
BEGIN 

IF LEVEL > 1 THEN ERR0R(194); 
NEW(COMMENT) ; SCANSTRING ( COMMENT" » 80 ) 
END! 

DEBUGGING := (SW=»+«)5 
FLIP3YTES := (SW='+«)5 

gotook := (Sw=«+*); 



c 



•D» 
•F* 



EXIT(COMMENTER) 
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IF (Sa'=' + «) OR (Syv='-») THEN IOCHECK := (SW=»+») 

ELSE 

BEGIN SCANSTRING(LTITLE,40) 5 
IF STOPPER = '*• THEN 

SYMCURSOR := SYMCURSOR+l; 
IF LIST THEN 
BEGIiJ 

SYMCURSOR := SYMCURSOR + 1! 
PRINTLINE; 

SYMCURSOR := SYMCURSOR - i; 
END; 
IF INCLUDING OR INMODULE AND ININTERFACE THEN 

BEGIN ERROR(406)5 EXIT(COMMENTER) END; 
OPENOLD(INCLFILE.LTITLE)! 
IF IORESULT <> THEN 

BEGIN OPENOLDUNCLFlLEtCONCATtLTlTLE.'.TEXTM); 

IF IORESULT <> THEN ERRORU03) 
END; 
INCLUDING := TRUE? 
OLDSYMCURSOR := SYMCURSOR; 
OLDLINESTART : = LINESTART; 
0LDSYM3LK := SYMBLK-2; 
SYMBLK := 2; GETNEXTPAGE; 
INSYMBOL; EXIT(INSYMBOL) 
END; 
IF (SW=*+») OR (SW= ( -') THEN 
BEGIN LIST != (SW=»+» ) ; 

IF LIST THEN OPENNEW( LP* •♦SYSTEM. LST. TEXT* ) 
END 
ELSE 

BEGIN SCANSTRING(LTITLE,40); 
OPENNEW(LPtLTITLE); 
LIST := IORESULT = 0; 
EXIT(COMMENTER) 
END; 
NOISY := (SW='-*)5 
WRITE(LP»CHR(12(*FF*))) ; 
RANGECHECK := (SW=» + M; 

noswap: = (Sw='-») ; 
tiny := (sw=«+«); 

IF (SW=' + M OR (SKIS*-*) THEN 
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BEGIN SYSCGMP := (Srt = •-•); 
rtANGECHECK := NOT SYSCOMP; 
IOCHECK := RANGECHECK; 
GOTOOK := SYSCOMP 
END 
ELSE 

IF NOT USING THEN 

BEGIN SCANST3ING(SYSTEMLIB,40) 5 

CLOSE(LIBRARY); LIBNOTOPEN := TRUE; 
EXIT(COMwiENTER) 
END 
END (*CASES*)i 
SYMCURSOR := SYMCURSOR+3; 
UNTIL DEL <> •♦•; 
SYMCURSOR := SYMCURSOR-i; (* ADJUST *) 
REPEAT 
REPEAT 

SYvtcURSOR := SYMCURSOR + 15 

WHILE SYMBUFP^LSYMCURSOR: = CHR(EOL) DO CHECKEND 
UNTIL SYMBUFP A C SYMCURSOR 3=STOPPERJ 
UNTIL (SYMBUFP^CSYMCURSOR+lUsMM OR ( STOPPERS !• ) ; 
SYMCURSOR := SYMCURSOR+i; 
END (*COMMENTER*) I 

PROCEDURE STRING; 

LABEL l; 

VAR 

t: packed array c1..80d of char; 
tPiNblanks.l: integer; 
duple: boolean; 

BEGIN 

DUPLE := FALSE; (* INDICATES WHEN '• IS PRESENT *) 
TP := 0; (* INDEX INTO TEMPORARY STRING *) 
REPEAT 

IF DUPLE THEN SYMCURSOR .'= SYMCURSOR + i; 
REPEAT 

SYMCURSOR := symcursor+i; 
tp := tp+i; 

if symbufp^csymcursorh = chr(eol) then 
begin error(202); checkend; goto 1 end! 
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tctp: := symsufp^csymcursord; 
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UNTIL SY,»1BUFP /% C.SY iV lt:URS0R3= , ♦ • » ; 
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duple := trul; 
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UNTIL SYM8UFP~CSYwicUKSQR + l J<>» t f i . 
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i: TP := TP-l; (* ADJUST *) 
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SY := STRINGCONST; op := noop; 
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LGTH := TP; (* GROSS *) 
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IF TP=1 (* SINGLE CHARACTER CONSTANT *) 
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THEN 
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VAL.IVAL := ORD(TCID) 
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ELSE 
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WITH SCONST* DO 
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3EGIN 
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CCLASS := STKG; 
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slgth := tp; 
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MO VELEFT ( TC 1 :] . SVALC ID f TP ) ; 
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val.valp := sconst 
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END(*STRING*) ; 
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PROCEDURE NUMBER; 
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VAR 
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EXPONENT »ENDItENDF,ENDE, SIGN tlPARTtFPART.EPART, 
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isum: INTEGER; 
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TIPEJ (REALTIPEilNTEGERTIPE); 


5016 


10 


25:q 


11 


Rsuw: real; 
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notlong: boolean; 
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K.J: integer; 


5019 


10 


25:o 





BEGIN 
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(* TAKES A NUMBER AND DECIDES WHETHER IT'S REAL 
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OR INTEGER AND CONVERTS IT TO THE INTERNAL 
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FORM. *) 
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TIPE := INTEGERTIPE! 
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sign := l; 
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notlong := true; 
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EPART := 9999! (* OUT OF REACH *) 
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IPART ;r SYMCURSOR; (* INTEGER PART STARTS HERE *) 
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150 

SYMC-JRSQR := SYMCUKSOR + I 
UNTIL CSYMuUFP^CSYMCURSORX' ()• ) OR ( SYMBUFP^C SYMCURSOR 1> * 9 » ) ; 
(* SYtfcurtSOP NOW POINTS AT FIRST CHARACTER PAST INTEGER PART *) 
ENDI := SYMCURSOR-i; (* MARK THE END OF IPART *) 
IF SYM3 JFP^CSYMCURS0R3=' . ' 
THEN 

IF SYM8UFP' S CSYWCURS0R + 1J<> , . • (* WATCH OUT FOR •..♦ *) 
THEN 
BEGIN 

tipe := realtipe; 
symcursor := symcursor+l; 
fpart := symcursor; (* beginning of fpart *) 
while (symbufp^csymcursor: >= '0') and 
(symbufp^csymcursorh <= »9») do 
symcursor := symcursor+l! 
if symcursor = fpart then err0r(2ql>; 
endf := symcursor-1! 

END? 
IF SYMBUFP^CSYMCURSOR^'E 1 
THEN 
BEGIN 

TIPE := REALTIPE; 
SYMCURSOR := SYMCURSOR+l; 
IF SYMBUFP*CSYMCURSOR3=»-« 
THEN 
BEGIN 

symcursor := symcursor+l ; 
sign := -1; 

END 
ELSE 

IF SYMBUFP' > CSYMCURSOR:=• + , 
THEN 

SYMCURSOR := SYMCURSOR+l; 
EPART := SYMCURSOR! (* BEGINNING OF EXPONENT *) 
*'HILE (SYMBUFP"CSYMCURSOR3>= , 0» J AND ( SYMBUFP^C SYMCURSORX=' 9 » ) DO 

SYMCURSOR ;= SYMCURSOR+l; 
ENDE := SYMCURSOR-l; 

IF ENDE<1EPART THEN ERRORJ201); I* ERROR IN REAL CONSTANT *5 
ENj; 
i* NOW CONVERT TO INTERNAL FORM *) 
IF ri^E = INTEGE:RTlPE THEN 
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BEGI.g 

is u*; := 0; 

FOR J := IPART TO ENDI DO 
3EGIN 

IF <ISUM>MAXINT DIV 10) OR < < ISUM=MAXINT DIV 10) AND 

arMH «ORD(SYMB'JFP-CJD) - ORD('O') > MAXINT MOD 10)) THEN 
BEGIN NOTLONG := FALSE! K := J; J ;= ENDI END 

ELSE ISUM := ISUM*10+(ORD(SYMBUFP^CJ3)-ORD( »0» ) ) : 

END; 

IF NOTLONG THEN 
BEGIN 

sy := intconst; op := noop; 
val.ival := isum; 

END 
ELSE 
8EGIN 

IF ENDI - IPART >r MAXDEC THEN 

BEGIN ERROR(203)J IPART := ENDI; K != ENDI END; 
NEW CLVP, LONG); 
WITH LVP* DO 

BEGIN CCLASS := LONG; J := 4; LLENG := 01 
WHILE K <= ENDI 00 
BEGIN 

IF J = 4 THEN 

BEGIN LLENG := LLENG + l; 
LONGVALCLLENGD X- ISUM; 

isum := 0; 
J := 
END; 

ISUM := ISUM * 10 + ORD(SYMBUFP*CKD>-ORD<'0»>; 
K 5= K + 1; J := J + l 

end; 
llast := j; 

IF J > THEN 

BEGIN LLENG := LLENG + 1? 
LONGVALCLLENGD := ISUM 

end; 
end; 
sy := longconst; op : = noop; 

LGTH := ENDI - IPART + 1! 
VAL.VALP := LVP 
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25:4 25 end; 

25:2 30 END (*TIPE = INTE GERTIPE* ) 

25: 1 30 ELSE 

25:2 j2 BEGIN <* REAL NUMBER HERE *) 

25:3 32 rsjm := o; 

38 FOR J := IPART TO ENDI DO 

49 BEGIN 

49 RSUM := RSUM*10+<ORD(SYMBUFP*Cj3)-ORD< •0 t ) ) 5 

67 END « 

74 FOR J := ENDF QOWNTO FPART DO 

85 rsUM := RSUM+(ORD<SYMBUFP*CJ3)-ORD( , , ))/PWROFTEN(J-FPART+1>| 

15 exponent := 0; 

18 FOR J := EPART TO ENDE DO 

29 EXPONENT := EXPONENT*10+ORD ( SYMSUFP^C Jl > -ORD< • • ) ! 

47 IF SlGN=-l THEN 

53 RSUM := RSUM/PWROFTEN(EXPONENT) 

60 ELSE 

67 rsum := rsum*pwroften(exponent) ; 

79 sy := realconst; op := noop; 

85 NEw(LVPtREEL) ! 

91 LVp^.CCLASS := REEL! 

96 lvp^.rval := rsum; 

07 val.valp •= lvp; 

12 end; 

12 symcursor := symcursor-i; (* adjust for posterity *) 

17 end unumber*) ! 

52 

BEGIN (* INSYMBOL *) 

IF GETSTMTLEV THEN BEGIN BEGSTMTLEV := STMTLEV; GETSTMTLEV : = FALSE END; 
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= NOOP; 

14 1: sy := othersy; (* IF no CASES EXERCISED BLOW UP *) 
17 CASE symbufp~csymcuRsor:j of 

:STRlNGi 
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•B» , 'C» 
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s't^*: 



, , F , , , G', 
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, 'F', »G'.'H», 'I't'JS'KS'L* 
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I0SEARCH(SYMCURS0R,SYMBUFP^) 5 (* MAGIC PROC *) 
BEGIN COMMENTED 1 3«) ; GOTO 1 END; 
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*) 



: BEGIN 

IF SYMBUFP*CSYMCJRSOR+13=»*» 
BEGIN 

SYMCURSOR := SYMCURSOR+l; 
COMMENTER( ♦*• ) ; 
SYMCURSOR := SYMCURSOR+l; 
GOTO i; (* GET ANOTHER TOKEN 
END 
ELSE 

sy .*= lpakent! 
end; 

sy := rparent; 
sy := comma; 

' ': BEGIN SYMCURSOR := SYMCURSOR+l; GOTO 
BEGIN 

IF SYMBUFP^c SYMCURSOR+l }=»,• 
THEN 
BEGIN 

SYMCURSOR := SYMCURSOR+l; 
SY .*= COLON 
END 
ELSE 

SY := period; 

end; 

IF SYMBUFP~CSYMCURSOR + i;|r» = « 

THEN 
BEGIN 

symcursor := symcursor+l; 
sy := becomes; 

END 

else 

sy := colon; 
sy := semicolon; 
sy := arrow; 

SY ."= LBRACK; 
SY := RBRACK; 
BEGIN SY := MULOP; 
BEGIN SY := addop; 
BEGIN SY := ADDOP; 
BEGIN SY := MULOP; 
BEGIN 



END? 



OP 
OP 
OP 
OP 



MUL END; 
PLUS END; 
MINUS END; 
RDIV END; 
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SY := RELOP; 
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op := ltop; 
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00 


CASE SYMBUFP^CSYMCURSOR+IH OF 
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'>•: BEGIN 
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op := neop; 
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SYFCURSOR := SYMCURSOR+l 
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END; 
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•=•: BEGIN 
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op := leop; 
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SYMCURSOR := SYMCURSOR+l 
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END 
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. END; 
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end; 
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'=•: begin sy := RELOP; op := eqop end; 


5210 


10 


6:i 


48 


'>•: begin 
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SY := RELOP; 
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IF SYMBUFP A CSYMCURSOR + i:i= , = » 
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THEN 
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BEGIN 
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OP := GEOP; 
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symcursor := symcursor+i: 
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op := gtop; 
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END (* CASE SYMBUFP^CSYMCURSORD OF *)5 
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IF SY=OTHERSY THEN 
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IF SYMBUFP A CSY«CURSORD = CHR(EOL) THEN 
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BEGIN CHECKEND; GETSTMTLEV := TRUE; GOTO 


5225 


10 


6:2 


31 


ELSE ERROR(400) ; 
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SYMCURSOR := SYMCURSOR+i; (* NEXT CALL TALKS 
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end uinsymbol*) ; 
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(*$i #5:procs.a.text*> 
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(*$I 35:PR0CS.B.TEXT*) 
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1 END 

ABOUT NEXT TOKEN *) 



*) 
*) 



CTP*) 
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IF FCP <> NIL THEN 

IF TREESEARCH(FCPtFCPl.ID) = THEN UNADA*) 
ELSE FCP1 := NIL 
ELSE FCP1 := NIL 
END (*SEARCHSECTION*) ; 

PROCEDURE SEARCHID(*FIDCLS: SETOFIDS5 VAR FCP: CTP*)5 

LABEL l; VAR LCP; CTP; 
BEGIN 

FOR DISX := TOP DOWNTO DO 

3EGIN LCP := displaycdisxd.fname; 

IF LCP <> NIL THEN 

IF TREESEARCH(LCPtLCPtlD) = THEN 
IF LCP^.KLASS IN FIDCLS THEN GOTO 1 
ELSE 

IF PRTERR THEN ERROR(103) 
ELSE LcP := NIL 
ELSE LCP := NIL 
END; 
IF PRTERR THEN 

BEGIN ERROR(104) ! 

IF TYPES IN FIDCLS THEN LCP := UTYPPTR 
EL^E 

IF ACTUALVARS IN FIDCLS THEN LCP := UVARPTR 

IF FIELD IN FIDCLS THEN LCP := UFLDPTR 
ELSE 

IF KONST IN FIDCLS THEN LCP := UCSTPTR 
ELSE 

IF PROC IN FIDCLS THEN LCP := UPRCPTR 
ELSE LCP := UFCTPTR 
ENd; 
*5 1: FCP := LCP 

END (*SEARCHID*) ; 

PROCEDURE GETBOUNDS(*FSP: STP; VAR FMI N ,FMAX: INTEGER*); 

WITH FSP* DO 

IF FORM = SUBRANGE THEN 

3EGIN FMIN := MIN.IVAL; FMAX := MAX.IVAL END 

ELSE 
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3EGIM FMIN := 0! 

IF *SP = CHAKPTR THEN FMAX != 255 
ELSE 

IF FSP~.FCONST. <> NIL THEN 

FMAX := FSP^.FCONST*. VALUES. IVAL 
ELSE FMAX := 
END 
END (*GETBOUNDS*) ; 

PROCEDURE SKIP(*FSYS: SETOFSYS*); 
BEGIN WHILE NOT(SY IN FSYS) DO INSYMBOL 
END (*SKIP*) 5 

FUNCTION PAOFCHARUFSP: STP): BOOLEAN*); 
BEGIN PAOFCHAR := FALSE; 
IF FSP <> NIL THEN 

IF FSP*. FORM = ARRAYS THEN 

PAOFCHAR := FSP^.AISPACKD AND (FSP~.AELTYPE = CHARPTR) 
END (*PAOFCHAR*) ; 

FUNCTION STRGTYPE{*FSP: STP) : BOOLEAN*)? 
BEGIN STRGTYPE := FALSE; 

IF PAOFCHAR(FSP) THEN STRGTYPE := FSP^.AISSTRNG 
END (*STRGTYPE*) 5 

FUNCTION DECSIZE(*i: INTEGER): INTEGER*); 

BEGIN DECSIZE := ( I + 3) DlV 4 + 1 (*GROSS. .MAXIMUM NEEDED SPACE*) 

(* BINARY FN. SHOULD BE ((1*332) DIV 100 + 1 + BITSPERWD) DIV BITSPERWD *) 

END (*DECSIZE*) 5 

procedure constant(*fsys: setofsys; var fsp: stp; var fvalu: valu*)j 
var lsp: stp; lcp: ctp; sign: (none.pos,neg) ; 
lvp: csp; 
begin lsp := nil; fvalu. ival := 05 
if not(sy in constbegsys) then 

begin error(50); skip{ fsys+constbegsys) end! 
if sy in constbegsys then 

BEGIN 

IF SY = STRINGCONSTSY THEN 
BEGIN 

IF LGTH = 1 THEN LSP .*= CHARPTR 
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else: 

BEGIN 

NEW(uSHiARRAYS.TRUEiTRUE) 5 
LSP* := STRGPTR*; 

LSP-.MAXLENG := LGTH; 
LSP^.INXTYPE := NIL; 
NEW(LVP) ; 

LVP~ := VAL.VALP~; 
VAL.VALP := LVP 
END; 
FVALU := VAL; INSYM30L 
END 
ELSE 
BEGIN 

SIGN := NONE; 

IF (SY = ADDOP) AND (OP IN CPLUS,MINUS3) THFN 

""iSrMO* = PLUS ™ EN SISN « ; "»"*««• «. NEGi 

end; 

IF SY = IDENT THEN 

BEGIN SEARCHlD(CKONST3tLCP) ; 
WITH LCP~ DO 

BEGIN LSP := IDTYPE; FVALU :r VALUES END! 
IF SIGN <> N ONE THEN 
IF LSP = INTPTR THEN 

BEGIN IF SIGN = NEG THEN 
^ FVALU. IVAL := -FVALU. IVAL END 

IF LSP = REALPTR THEN 
BEGIN 

IF SIGN = NEG THEN 
BEGIN NEW(LVP.REEL); 
LVP^.CCLASS ;= reel; 
LVP^.RVAL := -fvalu.valp~.rval; 

FVALU. VALP := LVP; 
END 
END 
ELSE 

IF COMPTYPES(LSP.LONGINTPTR) THEN 
BEGIN 

IF SIGN = NEG THEN 



457 



5359 


10 


14:3 


34 


5360 


10 


14:4 


39 


5361 


10 


14:4 


42 


5362 


10 


14:4 


62 


5363 


10 


14:3 


£3 


5364 


10 


i4:i 


65 


5365 


10 


14:0 


b5 


5366 


10 


14:7 


70 


5367 


10 


14:6 


72 


5368 


10 


14:5 


72 


5369 


10 


14:6 


74 


5370 


10 


14:7 


79 


5371 


10 


14:8 


89 


5372 


10 


14:7 


97 


5373 


10 


14:6 


99 


537*+ 


10 


14:7 


01 


5375 


10 


14:8 


06 


5376 


10 


14:0 


11 


5377 


10 


14:9 


24 


5378 


10 


14:8 


33 


5379 


10 


14:7 


35 


5380 


10 


i4:e 


37 


5381 


10 


14:9 


42 


5382 


10 


14:0 


42 


5383 


10 


14:1 


47 


5384 


10 


14:2 


68 


5385 


10 


14:2 


73 


5386 


10 


14:2 


81 


5387 


10 


14:2 


86 


5388 


10 


14:2 


91 


5389 


10 


14:1 


91 


5390 


10 


14:9 


93 


5391 


10 


14:8 


93 


5392 


10 


14:9 


95 


5393 


10 


14:4 


07 


5394 


10 


14:3 


07 


5395 


10 


14:4 


17 


5396 


10 


14:2 


29 


5397 


10 


14:1 


29 


5398 


10 


14:0 


30 


5399 


10 


i4:o 


52 



453 

BEGIN NEW<LVP»LONG) ! 
LVP~.CCLASS := long; 

LVP*.LONGVALCi: := - FVALU. VALP*.LONGVALCl3J 
FVALU. VALP := LVP 
END 
END 
ELSE ERRORQ05) ; 
INSYMBOL5 
END 
ELSE 

if sy = intconst then 
begin if sign = neg then val.ival := -val.ival! 
lsp := intptr; fvalu := val; insymbol 

END 
ELSE 

if sy = realconst then 
begin if sign = neg then 

val,valp a .rval := -val. valp^.rval; 
lsp := realptr; fvalu := val; insymbol 

END 
ELSE 

IF SY = LONGCONST THEN 
BEGIN 

IF SIGN = NEG THEN 

BEGIN VAL. VALP*. LONGVALC13 := - VAL. VALP*. LONGVALCIIN 
NEW(LSPiLONGINT) ! 

lsp". size := decsizeugth); 
lsp a .form := longintj 
fvalu := val; 
insymbol 

END 
END 
ELSE 

begin error(106)j skip(fsys) end 

end; 
if not (sy in fsys) then 
begin err0r(6); skip(fsys) end 

END; 
FSP := LSP 

END (*C0NSTANT*) ; 



s!ln? IS ^i D « FUNCTIDN C0MPTYPES(*FSP1.FSP2: STP) : BOOLEAN*); 

sunJ ir J^' ! VAR : ^T1,NXT2: C T P! CUMP: BOOLEAN; 

,, Uil 10 lb '° 3 LTESTP1.LTESTP2 : TESTP; 

5403 10 15:0 Q fjEGlN 

-l° n t J5 J? 11 ° IF FSP1 = FSP2 T hEN COMPTYPES := TRUE 

o*+ud io 15. i 5 ELSE 

5407 ]°0 lt\?_ 19 ELSE FSP1 = NlL> ^ (FSP2 = NIU ™ EN C0MPTYPES := TRUt 

till JS l^f *? " IF FSp l A » F °RM = FSP2%F0RM THEN 

=i ?« ° 4 31 CA SE FSP1-.FORM OF 

5410 10 15:4 35 scalar: 

llil J2 ^ I5 35 COMPTYPES := FALSE! 

5412 10 15:4 40 subrange: 

5414 10 15-S IS COMPTYPES := COMPTYPES(FSPl«.RANGE T YPE, 

5415 10 15:4 52 M , M ™. F S P2«.RANGETYPE> ; 



5416 10 15:5 52 



POINTER: 
BEGIN 



5418 lS "•'! II , C 2 MP T ; = FALSE! LTESTP1 •'= GLOBTESTP; 

5419 10 15-A « LTESTP2 := GLOBTESTP; 

5420 lS il.*7 tl WHILE LTESTP1 <> NIL DO 
w? IS JJ:I S? WITH LTESTP1- DO 

5421 10 15:8 71 BEGIN 

5423 iS Wl 11 IF (ELT1 = F SP1%ELTYPE) AND 

5424 10 15 : 9 87 <ELT2 = F SP2^.ELTYPE) THEN COMP := TRUE; 

5425 iS lt\l 8 8 7 ENdI"™ ' = LASTTESTP 

?J?7 IS lV.t II IF N0T c0MP TH EN 

till iS 11:1 II BEGIN ^W(LTESTPl); 

till IS iti il WITH LTESTP1- DO 

5430 iS it'l ?i BEGIN ELT1 := f spi^.eltype; 

5431 Jo «:! ,4 ELT2 := FSP2-.ELTYPE; 

5432 iS llll a' ^ ASTTESTP := ^BTESTP 



END; 



ItU \° "'J « GLOBTESTP :« LTESTPi; 

5435 10 ":'? 28 EN D° MP ' = C0MPTYPES (FSP1 ^ EL TYPE,FSP2%ELTYPE , 

5^37 iS lilt 37 En" MPT " PE:S ^ C0MP? GL ° BTESTP : = LTESTP2 

till iS is 5 !! J? ^2«? t; "mptypes : = true; 

5440 10 15:5 47 COMPTYPES := COMPTYPES <FSPl«.ELSET,FSP2*.ELSET ) J 
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arrays: 

BEGIN 
COMP 



;= comptypes(Fspi' n .ae:ltypEiFSP2' v .aeltype) 



AMD 

if comp and 
comp := 



(FS D 1~.AISPACKQ = FSP2~.AISPACKD) 
FSP1 A .AISPACKD THEN 
(FSDl^.ELSPERWD = FSP2%El_SPERWD ) 
AND (FSPI'.ELWIDTH = FSP2~.ELWIDTH ) 
AND (FSPI^.AISSTRNG = FSP2~.AISSTRNG ) 
NOT STRGTYPE(FSPl) THEN 
FSP2*.SIZE) ; 



IF COMP AND 

COMP := (FSPl^.SIZE = 

comptypes := comp; 
end; 
records: 
begin nxt1 := fspl^.fstfld; nxt2 : = fsp2' s .fstfld ; 

comp := true? 

while (nxt1 <> nil) and (nxt2 <> nil) and comp do 

BEGIN C0MP:=CQMPTYPES(NXT1' S .IDTYPE»NXT2*.IDTYPE); 



NXT1 

end; 
comptypes 



;= nxti^.next; nxt2 := nxt2*.next 



NIL) AND 
= NIL) 
= NIL) 



!= COMPTYPES (FSPl*.FILTYPEtFSP2*.FILTYPE) 



1= COMP AND (NXT1 = 
AND (FSPl^.RECVAR 
AND (FSP2*.RECVAR 

END! 

files: 
comptypes 

END (*CASE*) 
ELSE <*FSP1~.F0RM <> FSP2*.F0RM*) 
IF FSPl^.FORM = SUBRANGE THEN 

COMPTYPES := C0MPTYPES(FSP1'\RANGETYPE.FSP2) 
ELSE 

IF FSP2-.F0RM = SUBRANGE THEN 

COMPTYPES := C0MPTYPES(FSP1,FSP2' S .RANGETYPE) 
ELSE COMPTYPES .*= FALSE 
END (*COMPTYPES*) ; 



(NXT2 = NIL) 



PROCEDURE GENBYTEUFBYTE: INTEGER*) 
8EGIN 

CODEP^CICD := CHR(FBYTE); 
END (+GENBYTE*) 5 



IC := IC+1 
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procedure senword(*fword: integer*); 

VAR TE*lP: CHAR; 
BEGIN 

IF OQQ(IC) THEN IC := IC + 1; 
!"I0VElEFT(FW0RD,C0DEP^CIcD,2) ; 
IF FL.IPBYTES then 
BESIN 

TEMP := CODERS I CD; 
CODEP^CICJ := CODEP^CIC+ID; 
CODEP*CIC+13 := TEMP 
END; 

ic := ic + 2 

END (*GENWORD*) ; 

PROCEDURE WRITETEXT; 
BEGIN 

MOVELEFT(SYMBUFP^CSYMCURSOR3»CODEP' s C0 3tl024) ; 
IF USERINFO.ERRNUM = THEN 

IF BLOCKWRITE(USLRINFO.WORKCODE'»»CODEP A C0J»2iCURBLK) <> 2 THEN 
ERR0R(402) ; 

CURBLK := CURBLK + 2 

END <*«IRITETEXT*) ; 

PROCEDURE WRITECODE(*FORCEBUF: BOOLEAN*); 

VAR CODEINX»LIC,i: INTEGER; 
BEGIN CODEINX := 0; LIC := IC; 

REPEAT 

i := 512-curbyte; 

IF I > LIC THEN I := LIC; 

MOvELEFTtCODEP-C CODEINX ZhDISKBUFCCURBYTED 1 1) ; 
CODEINX := CODElNX+i; 

curbyte := curbyte+i; 

if (curbyte = 512) or f0rce8uf then 

BEGIN 

IF USERINFO.ERRNUM = THEN 

IF BLOCKWRITE<USERINFO.WORKCODE%DISKBUF,1. CURBLK) <> 1 THEN 
ERROR(402); 

CURBLK := CURBLK+i; CURBYTE := 

END; 
Lie := LIC-I 
UNTIL LIC = 0; 
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5523 10 19:0 11 END ( * w r ITECODE* ) ; 

5524 U 19:0 <?6 

5525 10 26:0 1 PROCEDjrE FINISHSEG? 

5526 10 26:0 1 VAR I: INTEGER; 

5527 10 2S.-0 BEGIN ic := o; 

5528 10 26>:i 3 FOR I := NEXTPROC-1 DOWNTQ 1 DO 

5529 10 26:2 17 IF pROCTABLEC U = THEN 

5530 10 26:3 25 GENWORD(O) 

5531 10 26:2 29 ELSE 

5532 10 26:3 33 3ENW0RD ( SEGINX+IC-PRQCTA3LEC I D ) i 

5533 10 26:i 54 GENBYTE ( SEG ) ; GENBYTE ( NEXTPROC-1 ) ; 

5534 10 26:i 63 SEGTA3LEC SEG3.CODELENG := SEGINX+IC; 

5535 10 26!1 74 WRITr C 0DE < TRUE ) ; SEGINX := 0; CODEINSEG := FALSE 

5536 10 26!0 80 END < *FINISHSEG* ) ; 

5537 10 26:0 98 

5538 10 26:0 98 

5539 10 26:0 98 (*$I #5 : PROCS.B.TEXT* ) 

5539 10 26:0 98 (*$I #5 : BLOCK .TEXT* ) 

5540 10 26:0 98 

5541 10 20.*D 1 PROCEDURE BLOCK{*FSYs: SETOFSYS*); 

5542 10 20:0 5 LABEL 1! 

5543 10 20:D 5 VAR BFSYFOUND: BOOLEAN? 

5544 10 20:D 6 

5545 10 27:D 1 PROCEDURE FINDFORW ( FCP: CTP)J 

5546 10 27:0 BEGIN 

5547 10 27U IF FCP <> NIL THEN 

5548 10 27:2 5 WITH FCP" DO 

5549 10 27:3 8 BEGIN 

5550 10 27:4 8 IF KLASS IN CPROCFUNCU THEN 

5551 10 27:5 16 IF PFDECKIND = DECLARED THEN 

5552 10 27:6 23 IF PFKIND = ACTUAL THEN 

5553 10 27:7 30 IF FORWDECL THEN 

5554 10 27:6 35 BEGIN 

5555 10 27:9 35 USERlNFO.ERRNUM := 117! WRITELN (OUTPUT ) ; 

5556 10 27:9 46 WRITE ( OUTPUT tNAME. » UNDEFINED 1 ) 

5557 10 27:8 75 END; 

5558 10 27:4 75 FINDFORW ( RLINK ) J FINDFORW (LLINK ) 

5559 10 27:3 81 END 

5560 10 27:0 83 END (*FINDFORW*) 5 

5561 10 27:0 96 

5562 10 20:0 BEGIN (*3L0CK*) 
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IF (MOSWAP) AND (STARTINCUP) then 
BEGIN 

SODYPART(FSYStNlL) 5 

exit(block); 
end; 
if (sy in cunitsytseparatsy]) and (not inmodule) then 

BEGIN 

UNITPART(FSYS + CUNITSY , INTERSY , IMPLESY, ENDSYD) ; 
IF SY = PERIOD THEN EXIT(BLOCK) 

end; 
newblOck:=true; 
repeat 

if not newblock then 

BEGIN 

op := false; stmtlev := o; ic := o; lineinfo := o; 

IF (NOT SYSCOMP) OR (LEVEL>1) THEN FINDF0RW(DISPLAYCT0P3.FNAME ) ; 
IF INMODULE THEN 

IF TOS-.PKEVLEXSTACKP~.DFPROCP = OUTERBLOCK THEN 
IF (SY = ENDSY) THEN 

BEGIN FINISHSEG5 EXIT(BLOCK) END 
ELSE IF (SY = BEGINSY) THEN 

BEGIN ERR0R(13); FINISHSEG; EXIT(BLOCK) END; 
IF SY = BEGINSY THEN INSYMBOL ELSE ERR0RU7); 
REPEAT 

BODYPART(FSYS + CCASESY3 - CENDSY3* TOS^.DFPROCP) ; 
BFSYFOUND := (SY = TOS^.BFSY) OR (INMODULE AND (SY = ENDSY))! 
IF NOT BFSYFOUND THEN 
BEGIN 

IF TOS^.BFSY = SEMICOLON THEN 

ERR0RQ4) USEMICOLON EXPECTED*) 
ELSE ERR0R(6); (* PERIOD EXPECTED *) 
SKlptFSYS + CTOS-.BFSY3); 
BFSYFOUND := (SY = TOS-.BFSY) OR (INMODULE AND (SY = ENDSY)) 

UNTIL (BFSYFOUND) OR (SY IN BLOCKBEGSYS) ; 
IF NOT BFSYFOUND THEN 
BEGIN 

IF TOS^.BFSY = SEMICOLON THEN ERR0R(14) 
ELSE ERROR(6)5 UPERIOD EXPECTED*) 
DECLARATIONPART(FSYS) ; 
END 
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ELSE 
BEGIN 

IF SY = SEMICOLON THEN INSYMBOL? 

IF (NOTCSY IN CBEGINSY,PROCSY,FUNCSY.PROGSYD) ) AND 
(T0S".6FSY = SEMICOLON) THEN 
IF NOT (INMODULE AND (SY = ENDSY)) THEN 
BEGIN 

EKR0R(6)S SKIP(FSYS); 
DECLARATIONPART(FSYS) ! 
END 
ELSE GOTO 1 
ELSE 
i: BEGIN 

WITH TOS*'DO 
BEGIN 

if dfprocp <> nil then 

dfprocp a ,inscope:=false; 
if issegment then 

BEGIN 

IF CODEINSEG THEN FINISHSEG5 
IF DLINKERINFO AND (LEVEL = 1) THEN 
BEGIN SEGTABLECSEG3.SEGKIND 1= 2; 

WRITELINKERINFO(TRUE) 
END 
ELSE 

IF CLINKERINFO THEN 

BEGIN SEGTABLECSEG3.SEGKIND := 2? 

writellnkerinfo( false) 
end; 
nextproc:=soldproc; 
seg:=doldseg; 
end; 
level:=doldlev; 
top:=doldtop; 
lc:=dllc; 

curproc:=poldproc? 
end; 
release(tos*.dmarkp) j 

ToSrrTOS^.PREVLEXSTACKP; 

NEWBLOCK:=(SY IN CPROCSY,FUNCSYtPROGSY3) ; 

END 
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END 



END 
END 

else 
begin declarationpart(fsys) ; 
if level = then 
if sy in cunitsy,separatsyd then 

BEGIN 

UNITPART(FSYS + CUNITSY , INTERSY , IMPLESY»ENDSY3) ; 
IF SY IN CPROCSY,FUNCSY,PROGSYD THEN DECLARATIONPART (FSYS) 
END 
END; 
UNTIL TOS = NIL; 
FINISHSEG; 

(♦slock*) ; 



BEGIN (* PASCALCOMPILER *) 
COMPINIT5 

TIME(LGTHtLOWTIME); 

BLOCK (3L0CKBEGSYS+STATBEGSYS-CCASESY 3){ 
IF SY <> PERIOD THEN ERR0R<21); 
IF LIST THEN 

begin screendots := screendots+1 ! 
symbufp a csymcursord := chr(eods 
symcursor := symcursor+i; 
printline 
end; 
userinfo.errblk := 05 

time(lgthistartdots) ? lowtime := startdots-lowtime; 
unitwrite(3»ic,7); 
if dlinkerinfo or clinkerinfo then 
begin segtablecseg3.segkind := 1; 
writelinkerinfo(true) 

END? 
CLOSE(LP»LOCK)5 

IF NOISY THEN WRITELN (OUTPUT ) ; 
WRITE(OUTPUT»SCREENDOTS» • LINES* ) ; 
IF LOWTIME > THEN 

WRITE(OUTPUTi»t ♦ , ( LOWTIME+30 ) DIV 60t 
ROUNDt (3600/LOWTIME)*SCREENDOTS) , • 
IF NOISY THEN 

BEGIN 



SECS, », 
LINES/MIN') 
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5686 10 1:3 96 WR I TEUnK OUTPUT) ? 

5687 10 H3 02 y»*iTE(OUTPJTt 'SMALLEST AVAILABLE SPACE = ' » SMALLESTSPACE 1 ' WORDS') 

5688 10 i:2 64 LND5 

5689 10 111 64 IC := 0; 

5690 13 i:i 67 FOR SEG := TO MAXSEG DO 

5691 10 112 31 WITH sEGTAQLECSEG 1 DO 

5692 10 H3 90 BEGIN GENWORD { DISKADDR ) ; GENWORD < CODELENG ) END; 

5693 10 i:i 09 FOR SE3 := TO MAXSEG DO 

5694 10 1:2 23 WITH sEGTABLEC SEG 3 DO 

5695 10 i:3 32 FOR LGTH := 1 TO 8 DO 

5696 10 i:4 47 GENBYTE(ORD(sEeNAMECLGTH3)) ; 

5697 10 ltl 74 FOR SEG := TO MAXSEG DO GENWORD ( SEGTABLECSEGiJ.SEGKlND ) ! 

5698 10 lU 04 FOR SEG := TO MAXSEG DO GENWORD( SEGTABLECSEG3.TEXTADDR) 5 

5699 10 111 34 FOR LGTH := 1 TO 80 t)0 

5700 10 1:2 49 IF COMMENT <> NIL THEN GENBYTE ( ORD (COMMENT*CLGTHD) ) ELSE GENBYTE(O); 

5701 10 i:i 77 FOR LGTH := 1 TO 256 - 8*(MAXSEG + 1) - 40 DO GENWORD(O); 

5702 10 111 13 CURBLK := 05 CURBYTE := Oi WRITECODE ( TRUE) 

5703 10 1:0 22 END (* PASCALCOMPILER *) 5 

5704 10 i:0 78 

5705 i:0 BEGIN (* SYSTEM *) 

5706 ltO END. 



AT THE TIME OF THE PRINTING OF THIS BOOK 
THE BASIC COMPILER WAS NOT LISTED. 

The BASIC compiler will be available in 
a supplimental book at some time in the 
future at additional cost, 

Thank you for your patience in the matter, ed. 
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1 (*$L PRINTER:*) 
1 C$1 LINKQ 1 



i |************** k ********************************^^ 

1 (* COPYRIGHT (C) 1978 REGENTS OF THE UNIVERSITY OF CALIFORNIA !! 

1 * PERMISSION TO COPY OR DISTRI3UTE THIS SOFTWARE OR DOcSS-' ' 

1 * TATION IN HARD OR SOFT COPY GRANTED ONLY BY WRITTEN LICENCE 

1 (* DPTATMPn FBflM Tur T mc -r t -r, .▼,- , ' "mi. I It. IV L J. L L l\l Jj t 



.. OBTAINED FRO- THE ^STIT^TE «S"iSFoSS«lSi SJsl^S.""" 8 ' " 



*) 
*) 

1 ( ******************************************^^ 

1 L$S+»U-tR+ 

1 

1 

1 UCSD PASCAL SYSTEM 

1 PROGRAM LINKER 

1 (VERSION I.5F) 

1 

1 WRITTEN SUMMER '78 BY 

1 ROGER T, SUMNER* IIS 

J- COPYRIGHT (C) 1978* REGENTS OF 

J THE UNIVERSITY OF CALIFORNIA 

1 ALL HOPE ABANDON YE WHO ENTER HERE 
* -DANTE 

1 3 
1 

1 PROGRAM SYSTEMLEVEL; 

1 

1 CONST 

1 SYSPROG = 4; 
1 

1 VAR 

1 SYSCQW: "INTEGER; 

2 GFILES: ARRAY CO. .53 OF INTEGER; 

3 USERINFO: RECORD 

8 filler: array co.,43 of integer; 

tt SLOWTERM, STUPID: BOOLEAN; 
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m o i:u 6 altmode: char; 

U2 Q 1: - ,, gotsy^* gjtcode: boolean; 

43 i-'r B WORKVlUt SYMVID, CODEVID: STRINGC73; 

44 ijn 3 riORKTlO, SYMTID. COOETID: STRINGH153 

45 o i:o a end; 

4b q i:u '54 filler: array co.-'o of integer; 

47 i:D 59 SYVID, DKVID: STRINGC73; 

46 ll'J 67 JUNKl, JUNK2I INTEGER; 

49 o i:u &9 cmdstate: integer; 

50 o i:d 70 

51 o i:u 70 l 

52 i:U 70 * THE LINKER IS MADE UP OF THREE PHASES: 

53 i:D 70 * PHASE1 WHICH OPEN ALL INPUT FILES, READS UP SEG TABLES 

54 o 1JD 70 * FROM THEM AND DECIDES WHICH SEGMENTS ARE TO BE 

55 o i:D 70 * LINKED INTO THE FINAL CODE FILE. 

56 i:D 70 * PHASE2 READS THE LINKER INFO FOR EACH SEGMENT THAT IS 

57 o i:D 70 * GOING TO BE USED, EITHER TO SELECT SEP PROCS FROM 

58 o 1!D 70 * OR COPY WITH MODIFICATIONS INTO OUTPUT CODE. 

5g 1:D 70 * THE MAIN SYMBOL TREES ARE BUILT HERE, ONE FOR EACH 

60 i:D 70 * CODE SEGMENT. 

61 o i:D 70 * PHASE3 DOES THE CRUNCHING OF CODE SEGMENTS INTO THEIR 

62 i:D 70 * ~ FINAL FORM BY FIGURING OUT THE PROCS THAT NEED TO 
6 , Q i:n 70 * BE LINKED IN, RESOLVES ALL REFERENCES (PUBLREF, 

64 o I'D 70 * GLOBREF, ETC), PATCHES THE CODE POINTED TO BY THEIR 

65 o i: D 70 * REFLISTS, AND WRITES THE FINAL CODE SEG(S). 

66 i:D 70 3 

67 i:d 70 

68 1 i:D 1 SEGMENT PROCEDURE LINKERUII, JJJ: INTEGER)? 

69 i 1:0 3 

70 i i:d 3 CONST 

71 1 llQ 3 HEADER = 'LINKER [I.5F3'? 

73 I \\l 3 MAXSEG = 15! C MAX CODE SEG U IN CODE FILES 3 

74 i i :d 3 MAXSEGl = 16? C MAXSEG+1, USEFUL FOR LOOP VARS 3 

75 i l!D 3 MASURSEG = 15 C USERHOST SEGMENT NUMBER « 3 

76 , i :D 3 FIRSTSEG = 7; C FIRST LINKER ASSIGNABLE SEG * 3 

77 i !•□ 3 MAXFILE =7; C NUMBER OF LIB FILES WE CAN USE 3 

78 i i| D 3 MAXLC = MAXINT; C MAX COMPILER ASSIGNED ADDRESS 3 

7 g : i-n 3 maxIc = 20000 5 C MAX NUMBER BYTES OF CODE PER PROC 3 

80 i ilo 3 MAXPPOC = 1605 E MAX LEGAL PROCEDURE NUMBER 3 

81 I i.Q 3 MSDELTA = 12; C MARK STACK SIZE FOR PU3/PRIV FIXUP 3 
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C SUBRANGES 3 
c -- J 

SEGRANGE = O..MAXSEG; 
SEGIr-JDEX = 0..MAXSEG1; 
LCRA.MGE = 1..MAXLCJ 
ICRANGE = 0..MAXIC5 
PROCRANGE = 1..MAXPROCI 

C MISCELLANEOUS J 



C SEG TABLE SUBSCRIPT TYPE 3 

L WISH WE HAD CONST EXPRESSIONS! 3 

C BASE OFFSETS A LA P-CODE 3 

Z LEGAL LENGTH FOR PROC/FUNC CODE 3 

C LEGIT PROCEDURE NUMBERS 3 



ALPHA = PACKED ARRAY CO. .73 OF CHAR; 
DISK3L0CK = PACKED ARRAY CO. .5113 OF 0..255; 

f?le E p FI ^cod F ef L ile; C TRICK C0MPILER T0 GET * FILE " 

CODEP = -DISKBLOCK? c SPACE MANAGEMENT... NON-PASCAL KLUDGE 3 

C -LINK INFO STRUCTURES 3 
C - 3 



PLACEP = ~PLACEREC; 
PLACEREC = RECORD 

srcbase, destbase: 
length: icrange 
end c placerec 3 ; 



C POSITION IN SOURCE SEG 3 



INTEGER; 



REFP = ~REFNODE; 

REFNODE = RECORD 

NEXT: REFPJ 

REFS: ARRAY 

END C REFNODE 



C IN-CORE VERSION OF REF LISTS 3 



CO. .73 
3 ; 



OF INTEGER; 



LITYPES r (EOFMARK. c END-OF-LINK-INFO MARKER 3 

C EXT REF TYPES. DESIGNATES 3 
C FIELDS TO 3E UPDATED BY LINKER 3 

nJISfp' C REFS T ° INVISI BLY USED UNITS (ARCHAIC?) 

GL0BREFl C REFS TO EXTERNAL GLOBAL ADDRS 3 
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PUBLREF* 

PRIVRET. 

CCNSTREF, 

C UtFINlNG T 
I LINKER VAL 

GLOQDEF* 

PU3LDEF* 

CQNSTDEF* 

C PROC/FUNC 
C TO PASCAL 
C TO PASCAL 

EXTPROC* 

EXTFJNC* 

SEPPROC* 

SEPFUNCi 

SEPPREF* 

SEPFREF) 5 



C REFS TO BASE 
C REFS TO BASE 
L REFS T3 HOST 

YPES, GIVES 

UES TO FIX REFS 
C GLOBAL ADDR 



LEV VARS IN HOST 3 

VARS, ALLOCATED BY LINKER 

BASE LEV CONSTANT 3 

3 

J 
LOCATION 3 



C BASE 
l BASE 



VAR LOCATION 3 
CONST DEFINITION 



INFO* ASSEM 
AND PASCAL 
INTERFACE 

C EXTERNAL 

C 

C 

L 
C 

c 



3 
3 
3 

PROC 

» FUNC 

SEPARATE PROC 

» FUNC 

REF TO 

REF TO 



TO 



LINKED 
it 



BE 
it it 

DEFINITION 
ii 



PASCAL 
ii 



SEP 
SEP 



PROC 

FUNC 



INTO PASCAL 
it ii 

RECORD 3 
«' 3 
3 

3 



LISET = SET OF LlTYPES! 
OPFORMAT = (WORD, BYTE* BIG); 



I INSTRUCTION OPERAND FIELD FORMATS 3 



C FORMAT OF LINK INFO RECORDS 
ALPHA; 

LlTYPES OF 



LIENTRY = RECORD 
NAME: 

case litype: 

SEPPREF* 
SEPFREF* 
UNITREF, 
GLOBREF, 
PUBLREF* 
PRIVREF, 

constref: 

(format! opformat; 
nrefs: integer! 
n words: lcrange; 
reflist: refp); 

EXTPROC. 

EXTFUNC, 
SEPPROC* 

sepfunc: 

(SRCPROC: 
rJPARAMS: 



procrange; 

INTEGER; 



HOW TO DEAL WITH THE REFS 3 
WORDS FOLLOWING WITH REFS 3 
SIZE OF PRIVATE OR NPARAMS 3 
LIST OF REFS AFTER READ IN 3 



THE PROCNUM IN SOURCE SEG 
WORDS PASSED/EXPECTED 3 



16<+ 

1S5 

166 

167 

165 

169 

170 

171 

172 

175 

174 

175 

176 

177 

178 

179 

180 

181 

182 

183 

184 

185 

186 

187 

188 

189 

190 

191 

192 

193 

194 

195 

196 

197 

198 

199 

200 

201 

202 

203 

204 



1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 



:d 
:d 
:d 
:d 
:d 
:d 
:d 
:d 
:q 
:d 
:d 
:d 
:d 
:d 
:d 
:d 
:d 



i:d 

i:d 

i: j 

l 

l 

l 

l 

l 

l 

l 

l 

l 

l 

l 

l 

l 

l 

l 

l 

l 

i:d 

i:d 

i:d 

i:d 

i:d 

i:d 

i:d 

i:d 

i:d 

i:d 

i:d 

i:d 

i:d 

i:j 

i:d 

i:d 

i:d 

i:d 

i:d 

i:d 

i:o 



3 
3 

< 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 



place: placed); 
slobdef: 

(homeproc: procraimge; 
icoffset: icrange); 

PUBLDEF: 

(saseoffset: lcrange); 
constdef: 

(constval: integer); 

EOFMARK: 

(NEXTLC: LCRANGE) 
END C LIENTRY 1 ; 



C POSITION IN SOURCE/OEST SEG 3 

I WHICH PROC IT OCCURS IN 3 

C ITS BYTE OFFSET IN PCODE 3 

C COMPILER ASSIGN WORD OFFSET 3 

C USERS DEFINED VALUE 3 

L PRIVATE VAR ALLOC INFO 3 



C SYMBOL TABLE HEMS 3 
C 1 

SYMP = "symbol; 
symbol = record 

llink, rlink, 

SLINK: symp; 
ENTRY? LIENTRY 
END C SYMBOL 3 \ 

C SEGMENT INFORMATION 3 
C — 3 

SEGKINDS =(LINKEDi 
HOSTSEG» 
SEGPROCi 
UNITSEGt 
SEPRTSEG); 

FINFQP = "FILEINFOREC; 



C BINARY SUBTREES FOR DIFF NAMES 3 
I SAME NAME* DIFF LITYPES 3 
I ACTUAL ID INFORMATION 3 



C NO WORK NEEDED, EXECUTABLE AS IS 3 

C PASCAL HOST PROGRAM OUTER BLOCK 3 

C PASCAL SEGMENT PROCEDURE* NOT HOST 3 

C LIBRARY UNIT OCCURANCE/REFERENCE 3 

C LIBRARY SEPARATE PROC/FUNC TLA SEGMENT 3 

C FORWARD TYPE DEC 3 



segp = "segrec! 
segrec = record 

srcfile: finfop; 

srcseg: segrange 

symtab: symp; 

case segkind: segkinds of 
seprtseg: 

(NEXT: SEGP) C USED FOR LIBRARY SEP SEG LIST 3 



C THIS STRUCTURE PROVIDES ACCESS TO ALL 3 
C INFO FOR SEGS TO BE LINKED TO/FROM 3 

Z SOURCE FILE OF SEGMENT 3 

C SOURCE FILE SEG # 3 

C SYMBOL TABLE TREE 3 
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* I 



205 
206 
207 
203 
209 
210 
211 
212 
214 

2m 

215 
216 
217 
218 
219 
220 
221 
222 
223 
224 
225 
226 
227 
228 
229 
230 
231 
232 
233 
23i* 
235 
236 
237 
238 
239 
240 
241 
212 
243 
244 
245 



1 
1 
1 
i 
I 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 



:o 

:o 
:d 
:u 
:d 
:c 

ID 

:d 
:d 
:o 
:d 
:o 
:o 
:d 
:d 
:d 
:d 



i:d 



l 
l 

l: 

1! 

i: 

1! 

i: 
l 



ID 

:d 

:D 
:D 
:d 
;d 
;d 
:d 
i:d 
i:d 
i:d 
i:d 
i:d 
i:d 
i:d 
i:d 
i:d 
i:d 
i:d 
i:d 
i:d 
i:d 
i:d 



3 

3 

5 
3 
3 
3 
3 
3 
3 
3 
3 
3 
3 
3 
3 
3 
3 
3 
3 
3 
3 
3 
3 
3 
3 
3 
3 
3 
5 
5 
6 
7 
7 
7 
9 
9 
10 
11 
11 
12 
13 



END C SEGKEC 3 ; 



VAR 



HOST/LIB FILE ACCESS 



INFO 1 
2 



I5SEGTBL = RECORD C FIRST FULL BLOCK OF ALL CODE FILES 3 
DISKINFO: ARRAY CSEGRANGE3 OF 
RECORD 

CODELENG, CODEADDR: INTEGER 
END C DISKINFO 3 5 
SEGNAME: ARRAY CSEGRANGE3 OF ALPHA} 
SEGKIND! ARRAY CSEGRANGE3 OF SEGKINDS; 
FILLER: ARRAY CO. .1433 of INTEGER 
END C I5SEGT6L 3 ; 

FILEKIND = (USERHOST. USERLIB, SYSTEMLIB); 



FILEINFOREC 



= RECORD 

next: finfop; c 

code: filepj c 

fkind: filekind; c 

SEGTBL: I5SEGTBL I 
END C FILEINFOREC 3 I 



LINK TO NEXT FILE THATS OPEN 3 
POINTER TO PASCAL FILE. . .SNEAKY ! 
USED TO VALIDATE THE SEGKINDS 3 
DISK SEG TABLE W/ SOURCE INFO 3 



HOSTFILE, 
LIBFILES: FINFOP; 

seplist: segp; 
reflitypes: liset; 



C HOST FILE INFO PTR, ITS NEXT = LIBFILES 3 

C LIST OF LIB FILES, USER AND SYSTEM 3 

C LIST OF SEP SEGS TO SEARCH THROUGH 3 

C THOSE LITYPES WITH REF LISTS 3 



TALKATIVE, 

usewqrkfile: boolean; 

errcount: integer; 
heapbase: ^integer? 

hostsp: segp; 

next3aselc: lcrange; 

seginfo: array csegrange3 of segp; 



C PTR TO HOST PROG OUTER BLOCK 3 

C NEXT BASE OFFSET FOR PRIVATE ALLOC 1 

C SEG IS AVAILABLE IF NIL 3 



246 

247 

248 

249 

25 

251 

252 

253 

254 

255 

256 

257 

258 

259 

260 

261 

262 

263 

264 

265 

266 

267 

268 

269 

270 

271 

272 

273 

274 

275 

276 

277 

278 

279 

230 

281 

282 

283 

284 

285 

286 



1 

I 

1 

1 

1 

1 

1 

1 

i 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 



i:o 

i::: 

i:d 

i:o 

i:d 

i:d 

i:d 

i:j 

i:o 

no 

i:d 

i:o 

i:d 

i:u 

2:0 

2:d 

2:0 

2:1 

2:1 

2:2 

2:2 

2:2 

2:3 

2:1 

2:1 

2:0 

2:0 

3:d 

3:d 

3:d 

3:d 

3:d 

3:d 

3:0 

3J0 
3:i 
3U 
3:i 
3U 
3:o 
3:o 



29 
30 
30 
51 
bl 
51 
bl 
11 
11 
12 
12 
12 
12 
12 

1 
43 




20 
20 
73 
81 
89 
93 
99 
00 
18 

1 

2 

2 

2 

2 

2 

2 





4 
19 
34 
37 
50 



mextseg: segindex; 
wapname: stringc40d; 

FOi Fli F2i F3i 
F4 » F5 » F6 » F7 t 

code: cooefile; 

flipped: boolean; 

print an error message and bump 
the error counter. 



C NEXT SLOT IN SEGINFO AVAILABLE D 



I INPUT FILES WITH LURKING PNTRS 1 

C OUTPUT CODE FILE. *SYSTEM. WRK.CODE 3 

Z ARE FILES BYTE-FLIPPED? 2 



PROCEDURE ERROR(MSG: STRING); 

VAR CH; CHAR; 
BEGIN 

WRITELN(MSG) ! 

REPEAT 

WRITELN(«TYPE <SP>(C0NTINUE), <ESC>< TERMINATE )»> ; 
READ(KEYBOARD» CH)? 
IF CH = USERINFO.ALTMODE THEN 
EXlT(LINKER) 
UNTIL CH = • • ; 

errcount := errcount+i 
end c error 1 ; 

procedure byteswap(var word: integer); 

VAR TEMPliTEMP2: PACKED RECORD 

case boolean of 
true: (val: integer); 
false: (Lowbyte: 0..255; 

HIGHBYTE: 0..255) 

end; 

l.VAL := WORD; 

2. LOWBYTE := TEMPI. HIGHBYTE ; 
2. HIGHBYTE := TEMPI .LOWBYTE ; 
:= TEMP2.VAL; 



EGIN 
TEMP 

TEMP 

TEMP 
WORD 

nd; 
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287 1 


3:0 


so 


288 1 


3:o 


so 


289 1 


3:0 


so 


290 1 


3:c 


so 


291 1 


3:0 


so 


292 1 


3:0 


50 


293 1 


3:0 


so 


294 1 


4:d 


3 


295 1 


4;o 





296 1 


4:1 





297 1 


4:0 


2 


293 1 


4:0 


18 


299 1 


s:d 


3 


300 1 


5:d 


5 


301 1 


5:0 





302 1 


5:1 





303 1 


5:1 


8 


304 1 


5:1 


8 


305 1 


5:1 


17 


306 1 


5:0 


17 


307 1 


5:0 


32 


308 1 


6:d 


1 


309 1 


6:0 





310 1 


6:1 





311 1 


6:0 


2 


312 1 


6:0 


16 


313 1 


7:d 


1 


314 1 


7:0 





315 1 


7:0 





316 1 


7:1 





317 1 


7:1 


9 


318 1 


7:0 


17 


319 1 


7:0 


30 


320 1 


8:d 


1 


321 1 


a:o 


4 


322 1 


8:d 


4 


323 1 


s:d 


4 


324 1 


a:o 


4 


325 1 


8:d 


4 


326 1 


8:d 


4 


327 1 


8:0 






* ROUTINES TO ACCESS OBJECT CODE SEGMENTS. THERE 

* IS SU3TLE 3USINESS INVOLVING -BYTE FLIPPING WITH 

* THE 16-3IT OPERATIONS. 
3 

c$r-: 

function fetch8yte(cp: codep; offset: integer): integer; 

BEGIN 

FETCHBYTE := CP^C OFFSET 3 
END C FETCHBYTE 3 ? 

FUNCTION FETCHW0RD(CP: CODEP; OFFSET: INTEGER): INTEGER; 

VAR i: INTEGER? 
BEGIN 

MOVELEFT<CP"COFFSET3« I» 2); 

C BYTE SWAP I 3 

IF FLIPPED THEN BYTESWAPCI); 

fetchword := i 

END C FETCHWORD 3 ; 

PROCEDURE STOREBYTE(VAL: INTEGER; CP: CODEP; OFFSET: INTEGER); 
BEGIN 

CP~C OFFSET 3 := VAL 
END C STOREBYTE 3 ! 

PROCEDURE STOREWORD(VAL: INTEGER; CP: CODEP! OFFSET: INTEGER); 
BEGIN 

C BYTE SWAP VAL 3 

IF FLIPPED THEN BYTESWAP ( VAL ) ? 

MOVELEFT<VAL» CP~COFFSET3 , 2) 
END C SToREWORD 3 5 

procedure storebigtval: integer; cp: codep5 offset: integer); 
var bigword: packed record 

case boolean of 
true: (Integ: integer); 

false: (L0W3YTE: 0..255; 
HIGHSYTE: 0..255) 
END; 
BEGIN 



326 
329 
330 
331 
332 
333 
334 
335 
336 
337 
338 
339 

3m 

342 
343 
344 
345 
346 
347 
348 
349 
350 
351 
352 
353 
354 
355 
356 
357 
358 
359 
360 
361 
362 
363 
364 
365 
366 
367 
368 



1 
1 
1 

1 

1 

X 

1 
1 
1 
1 
1 
1 
1 
1 
1 
1 

* 
X 

1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 



:i 

:i 
:i 

;o 

< <*. 

• tj 

:o 
:o 

;j 

:o 

:C 

;o 
:o 

D 

;d 

D 

D 



9:0 
9:d 
9:d 
9:0 
9:o 

9.*1 

9:2 
9:3 

9:4 
9:4 
9:4 
9:4 
9:4 
9:3 
9:0 
9:0 
9:0 
9:0 
9:0 
9:0 
9:0 
9:0 
9:0 
9:0 
10:0 





5 

15 

<>5 

38 

33 

38 

38 

38 

38 

38 

33 

38 

1 

2 

3 

3 

3 

3 

3 





17 

29 

29 

32 

37 

49 

53 

64 

71 

86 

86 

86 

86 

86 

86 

86 

36 

86 

1 



3igw0r0.integ := val? 

cp~c offset d := bigword , highbyte + 128? 

cp^copfslt + 13 := 31&w0rd.l0w3yte; 

end; 



BYTE-FLIP WORD QUANTITIES IN SEGMENT DICTIONARY 
FOR BYTE-FLIPPED- FILE CASE ON READING AND WRITING 
SEGTA3LES. CALLED BY PHASE1 AND PHASE3. 



PROCEDURE 
VAR 



TABLE: I5SEGTBL) 



FLIPTA3LEUAR 

s: segrange; 

WORD: RECORD 

case boolean of 
true: (int: integer)! 
false: (kind: segkinds) 
end; 



BEGIN 
FOR 



MAXSEG DO 
DISKINFOCS3 



END: 

C 
* 

* 

* 
* 

3 



:= to 

with table, diskinfocs3 do 

BEGIN 

byteswap(codeaddr) ; 
byteswap(codeleng) ; 
word. kind := segkindcs3; 
byteswap(word.int) ; 
segkindcs3 := word. kind; 
end; 



ENTER MEWSYM IN SYMTAB TREE. THE TREE IS BINARY FOR 
DIFFERENT NAMES AND ENTRIES WITH THE SAME NAME ARE ENTERED 
ONTO SIDEWAYS LINKS (SLINK). NO CHECK IS MADE FOR DUP 
ENTRY TYPES, CALLER MUST DO THAT. NODES ON SLINK WILL 
ALWAYS HAVE NIL RLINK AND LLINK. 



PROCEDURE ENTERSYM(NEWSYM; SYMP; VAR SYMTAB: SYMP); 



477 






369 1 10:C 3 VAR SYP, LASTSYP: SYMP; 

370 i io:u 5 useleft: boolean*' 

371 i io:o begin 

372 1 10:i NEWSYM^.LLINK := MIL! 

373 1 10:i 5 NEWSYM^.RLINK := NILS 

374 1 10:i 10 NEWSYM-, SLINK := NIL! 

375 1 10:i 13 IF SYMTAB = NIL THEN 

376 1 10:2 19 SYMTAB : = NEWSYM 

377 1 10:i 20 ELSE 

378 1 10:2 21 BEGIN C SEARCH SYMTAB AND ADD NEWSYM 3 

379 1 10:3 24 SYP := SYMTAB; 

380 1 10:3 28 REPEAT 

381 1 10!4 28 LASTSYP := SYP? 

382 1 10:4 31 IF SYP*. ENTRY. NAME > NEWSYM*. ENTRY. NAME THEN 

383 1 10:5 42 BEGIN SYP := SYP*.LLINK; USELEFT := TRUE END 

384 1 1014 49 ELSE 

385 1 10:5 51 IF SYP*. ENTRY, NAME < NEWSYM*. ENTRY. NAME THEN 

386 1 10:6 62 BEGIN Srp := SYP*.RLINK; USELEFT := FALSE END 

387 1 10:5 69 ELSE C EQUAL 1 

388 1 10:6 71 BEGIN C ADD INTO SIDEWAYS LIST 1 

389 1 10:7 71 NEWSYM*. SLINK := SYP*. SLINK; 

390 1 10:7 75 SYP*. SLINK := NEWSYM5 

391 1 10:7 78 LASTSYP := NIL! C ALREADY ADDED FLAG 1 

392 1 10:7 81 SYP := NIL C STOP REPEAT LOOP 3 

393 1 10:6 81 END 

394 1 10:3 34 UNTIL SYP = NIL? 

395 1 10:3 89 IF LASTSYP <> NIL THEN 

396 1 10:4 94 BEGIN C ADD TO BOTTOM OF TREE 3 

397 1 10:5 94 IF USELEFT THEN 

398 1 1016 97 LASTSYP*. LLINK := NEWSYM 

399 i 10:5 00 ELSE 

400 1 1016 04 LASTSYP*. RLINK t= NEWSYM 

401 1 10:4 07 ENO 

402 1 10:2 09 END C SYMTAB <> NIL 3 

403 1 10:0 09 END C ENTERSYM 3 i 

404 1 10:0 24 

405 1 10:0 24 c 

406 1 10:0 24 * LOOK UP NAME IN SYMTAB TREE AND RETURN POINTER 

4C7 1 lOCO 24 * TO IT, OKTYPE RESTRICTS WHAT LITYPE IS 

408 1 10:0 24 * ACCEPTABLE. NIL IS RETURNED IF NAME NOT FOUND. 

409 1 10:0 24 3 



410 

411 

112 
413 

415 

416 

417 

413 

419 

420 

421 

422 

423 

424 

425 

426 

427 

428 

429 

430 

431 

432 

433 

434 

435 

436 

437 

438 

439 

440 

441 

442 

443 

444 

445 

446 

447 

448 

449 

450 



1 
1 

1 

X 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 
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1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 



10 

11 
11 
11 
11 
11 
11 
11 
11 
11 
11 
11 
11 
11 
11 
11 
11 
li; 

11! 
11! 
11! 
11! 
11! 
11! 

n:o 

11:0 

11:0 

12:d 

12:0 

12:0 

12:0 

12:1 

12:2 

12:3 

12:4 

12:5 

12:6 

12:7 

12:3 

12:2 

12:1 



:o 
:i 
:i 
:i 
:2 

.'3 
. £ 

:3 
:4 
:3 

.•4 
:5 

:4 

lb 

:o 
:o 
;o 
:o 
:o 
:o 
:o 



24 
3 
6 


3 
6 
11 
20 
21 
26 
35 
36 
41 
47 
48 
53 
59 
76 
76 
76 
76 
76 
76 
76 
76 
76 
3 
6 
6 

6 
11 
11 
16 
33 
48 
62 
71 
72 
77 



FUNCTION 3YMSRCH(\/AK NAME: ALPHA; 

VAR SYp; symp; 
3E&I1M 

symsrch := nil; 
syp := symtab; 
while syp <> nil do 

IF SYP^. ENTRY. NAME > NAME THEN 

SYP := SYP^.LLINK 
ELSE 

IF SYP^. ENTRY. NAME < NAME THEN 

SYP := SYP^.RLINK 
ELSE C EQUAL NAME 2 

IF SYP^. ENTRY. LITYPE <> OKTYPE THEN 

SYP := SYP*. SLINK 
ELSE C FOUND! J 

BEGIN SYMSRCH := SYP! SYP := NIL END 
END C SYMSRCH 2 5 



OKTYPE: LITYPES; SYMTAB: SYMP): SYMP; 



SEARCH FOR THE OCCURANCE OF THE UNIT SEGMENT 
GIVEN BY NAME IN THE LIST OF FILES IN FP. 
RETURN THE FILE AND SEGMENT NUMBER IN SEG. 
NIL IS RETURNED FOR NON-EXISTANT UNITS AND 
AN ERROR IS GIVEN. 



FUNCTION UNITSRCH(FP; 
LABEL 1; 

VAR SI SEGINDEX; 
BEGIN SEs := 0; 

WHILE FP <> NIL DO 
BEGIN 

WITH FP^.SEGTBL 
FOR S := TO 



FINFOP; VAR NAME! ALPHA; VAR SEGI SEGRANGE): FINFOP; 



FP 

end; 
write( 'unit 



DO 

MAXSEG DO 
IF SEGNAMECSJ = NAME THEN 

IF SEGKINDCS3 = UNITSEG THEN 
GOTO 1; 
= FP^.NEXT 



NAME) 
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430 



45i : 


L 12:i 


01 


452 : 


I 12:i 


lb 


453 


L 12:i 


22 


454 ; 


L 12:i 


22 


455 


L 12:i 


28 


456 : 


L 12:0 


28 


457 : 


L 12:0 


48 


458 


L 12:0 


48 


459 


L 12:0 


48 


460 3 


I 12:3 


48 


461 : 


L 12:0 


48 


462 3 


L 12:0 


48 


463 3 


L 12:0 


48 


464 3 


L 13ZD 


3 


465 3 


L 13ID 


4 


466 3 


l i3:o 


4 


467 3 


L 1310 





468 3 


L 13:i 





469 ] 


L 13:i 


3 


470 3 


L 13:2 


14 


471 3 


L 13:3 


39 


472 3 


13:1 


48 


473 3 


I 13:i 


51 


474 1 


13:0 


51 


475 3 


L 13:0 


06 


476 3 


13:0 


66 


477 3 


13:0 


66 


478 3 


L 13:0 


OO 


479 3 


L 13:0 


56 


480 3 


L 13:0 


66 


481 3 


1 13:0 


66 


482 3 


L 14:d 


3 


483 3 


14:d 


4 


484 3 


14:0 


4 


485 3 


l 14:d 


4 


486 3 


14:d 


4 


487 3 


14:d 


4 


488 3 


14:0 





489 1 


14:1 





490 1 


14:1 


3 


491 1 


14:0 


3 



ERROR ( • NOT FOUND* ) ; 

s := 0; 

1: 

SEG := Si 

UNITSRCH := FP 
END C UNITSRCH 1 i 



* ALPHA3ETIC RETURNS TRUE IF NAME CONTAINS ALL LEGAL 

* CHARACTERS FOR PASCAL IDENTIFIERS. USED TO VALIDATE 

* SEGNAMES AND LINK INFO ENTRIES. 

1 

FUNCTION ALPHABETIC(vAR NAME! ALPHA): BOOLEAN? 

LABEL l; 

VAR I: INTEGER; 
BEGIN 

ALPHABETIC := FALSE? 

FOR I := TO 7 DO 

IF NOT (NAMECI3 IN [•A'.i'Z't , , ..»9 , « • '• ' -' 1) THEN 

GOTO 15 
ALPHABETIC := TRUE; 
i: 

END C ALPHABETIC 1 ; 



* GETCOOEP IS A SNEAKY ROUTINE TO POINT CODEP'S ANYWHERE 

* IN MEMORY, IT VIOLATES ROBOT'S RULES OF ORDERt BUT IS 

* VERY USEFUL FOR DEALING WITH THE VARIABLE SIZE SEGMENTS 
1 

FUNCTION GETCODEPIMEMADDR: INTEGER): CODEP; 
VAR r: RECORD 

CASE 300LEAN OF 

true: (i: integer); 
false: <p: codep> 

End; 

3EGIN 

r.i := memaddr; 
getcodep := R.p 
end c getcodep 1 \ 



492 i m:o is 

49i 1 I4t0 13 C$1 LINKO J 

493 i m:c is c*i linki i 
494- i i** : q is 

^s i i*+:u is (*** + *******************************♦**♦***************************) 

496 1 lf:c 18 (* *) 

1+97 1 1*^0 18 (* COPYRIGHT (C) 1978 REGENTS OF THE UNIVERSITY OF CALIFORNIA. *) 

* Sa 1 l *'-0 18 (* PERMISSION TO COPY OR DISTRIBUTE THIS SOFTWARE OR DOCUMEN- ♦) 

499 1 l<+:o 18 (* TATION IN HARD OR SOFT COPY GRANTED ONLY BY WRITTEN LICENSE *) 

500 1 l^JO 18 (* OBTAINED FROM THE INSTITUTE FOR INFORMATION SYSTEMS, *) 

501 1 14:o 18 (* *, 

502 1 1410 18 I******************************************************************) 
505 1 14IC 18 

504 1 l«*:o 18 C 

5 5 1 l^SO 18 * PHASE 1 OPENS HOST AND LIBRARY FILES AND 

506 1 14:3 18 * READS IN SEG TABLES. ALL FIELDS ARE VERIFIED 

507 1 1450 18 * AND THE HOSTFILE/LlBFILES FILE LIST IS BUILT. 
5 °S 1 l*+!0 18 * THE PROTOTYPE FINAL SEG TABLE IS SET UP IN 

509 1 14!0 18 * SEGINFOC*: FROM THE HOST FILE AND THE SEP SEG 

510 1 1**!0 18 * LIST IS SET UP FOR SEARCHING IN LATER PHASES. 

511 1 14:0 18 3 

512 1 14:0 18 

513 1 15:0 1 PROCEDURE PHASEl; 

514 1 15:d 1 

515 1 15:D 1 VAR C FOR USE WITH BYTE FLIPPING 1 

516 i i5:d i highbyte: 0..1; 

517 1 15ID 2 INT: RECORD 

518 1 15:d 2 CASE BOOLEAN OF 

519 i 15 JD 2 true: <val: integer); 

520 1 15: D 2 FALSE: (BYTE: PACKED ARRAY CO. ,13 OF 0..255) 

521 1 15:D 2 END; 

522 1 15:d 3 C 

523 1 15:D 3 * BUILD FILE LIST OPENS INPUT CODE FILES AND READS SEGTBLS. 

524 1 15:d 3 * THE VAR HOSTFILE IS SET UP AS HEAD OF LINKED LIST OF FILE 

525 1 15:D 3 ♦ INFO RECS. THE ORDER OF THESE FILES DETERMINES HOW ID'S 

526 1 15:D 3 * WILL BE SEARCHED FOR. NOTE THAT LIBFILES POINTS AT THE 

527 1 15:D 3 * LIST JUST PAST THE HOST FILE FRONT ENTRY. 

528 1 15:d 3 1 

529 1 15:D 3 

530 1 16:D 1 PROCEDURE BUILDFILELIST ; 

531 1 16:D 1 LABEL l; 
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VAR F: 0..MAXFILE! 
i: INTEGER; 
Pf d: FINFCP* 
FNAME: STRINGC39D5 



* SETUPFILE OPENS FILE AND ENTERS NEW FINFO REC IN 

* HOSTFILE LIST. SEGTBL IS READ IN AND VALIDATED. 

1 

PROCEDURE SETUPFILE<NUM: INTEGER; KIND: FILEKIND; TITLE: STRING); 
LABEL li 

var errs: integer; 
s: segindex; 
cp: filep; 
fp: finfop; 
alllinked: boolean; 
goodkinds: set of SEGKINDS; 

* GETFILEP RETURNS A POINTER TO A FILE USING UNSPEAKABLE 

* METHODS* BUT THE ENDS JUSTIFY THE MEANS. 

1 



FUNCTION 

VAR a: 
BEGIN 

CSR-J 

GETFILEP 

CSR+3 
END C GETFILEP 



GETFILEP(VAR F: 
ARRAY CO.. 3 OF 



codefile) 
filep; 



FILEP; 



:= ac-13; 



BEGIN C SETUPFILE 3 

CASE NUM OF 

0: CP := GETFILEP(FO) 

I; CP := GETFILEP(FI) 

Zl CP := GETFILEP(F2) 

3: CP := GETFILEP1F3) 

4: CP := GETFILEP(F4) 

5: CP := GETFILEP1F5) 

6: CP := GETFILEP(F6) 
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7: CP := GETFILEP(F7) 
END C CASES J 5 
RESET(CP% TITLE); 
IF IORESULT <> THEN 

IF TITLE <> •IN toORKSPACE , THEN 
BEGIN 

INSERTt '.CODE', TITLE, LENGTH ( TITLE ) +1 ) ; 
RESET(CP~, TITLE) 
END; 
IF IORESUlT <> THEN 
BEGIN 

inserting" file •, title* 1); 
error(title) ; 
if kind <> userhost then 
errcount := errcount-1 

END 
ELSE 

BEGIN C FILE OPEN OK 1 
IF TALKATIVE THEN 

WRITELN(»0PENING », TITLE)? 
NEW(FP); 

FP^.NEXT := hostfile; 
fp^.code := cp; 
fp^.fkind := kind? 

IF BLOCKREAD(CP~t FP~. SEGTBL* If 0) <> 1 THEN 

ERRORCSEGTBL READ ERRM 
ELSE 

BEGIN C NOW CHECK SEGTBL VALUES ] 

IF NUM = THEN C DETERMINE IF FILE IS BYTE-FLIPPED 3 
FOR S := TO MAXSEG DO 
BEGIN 

INT.VAL := ORDIFP*. SEGTBL. SEGKINDCSD); 
FLIPPED := (INT.BYTECHIGHBYTE3 <> 0); 
IF FLIPPED THEN 
GOTO 11 
END; 
i: IF FLIPPED THEN 

FLIPTABLE(FP~. SEGTBL) ; 

S := 0; ALLLINKED := TRUE; 
ERRS := ERRCOUNT; 
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END 



IF KIND = USERHOST THEN 

GOODKINDS := CLINKEOiSEGPROC,SEPRTSEGtHOSTSEGiUNlTSEG3 

ELSE 

GOODKINDS := CLINKED, UNITSEG.SEPRTSEGDi 

WITH FP^.SEGTSL DO 
REPEAT 

INT.VAL := ORD(SEGKINDCSD) ; 

IF (INT.BYTECHIGHBYTE3 <> 0) THEN 

BEGIN 

ERR0RC3AD BYTE SEX'); EXIT(LINKER) 

end: 

ALLLINKED := ALLLINKED AND (SEGKINDCSD = LINKED)! 

IF (DISKINFOCSD.CODELENG = 0) 

AND (SEGKINDCS3 <> LINKED) THEN 

IF (KIND <> USERHOST) 

OR {SEGKINDCS} <> UNITSEG) THEN 
ERROR( 'FUNNY CODE SEG' ) 5 
IF (DISKINFOCS3.CODELENG < 0) 
OR (DISKINFOCS3.CODEADDR < 0) 
OR (DISKINFOCS3.CODEADDR > 300) THEN 

ERR0RC3AD DISKINFO'); 
IF NOT (SEGKINDCS3 IN GOODKINDS) THEN 

ERR0RP3AD SEG KIND') J 
IF NOT ALPHABETIC(SEGNAMECS3) THEN 

ERR0RC3AD SEG NAME*) 5 
IF ERRCOUNT > ERRS THEN 

s := maxseg; 

S * ~ S+l 
UNTIL S > maxseg; 
IF ALLLINKED AND (KIND = USERHOST) THEN 
BEGIN 

WRITECALL SEGS LINKED'); 
EXIT(LINKER) 
END? 
IF ERRCOUNT = ERRS THEN 
HOSTFILE := FP 
END 
END 
C SETUPFILE D 5 
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BEGIN C 3UIL0FILELIST 1 
IF TALKATIVE THEN 
3EGI.M 

FOR I := 1 TO 7 DO 

WRITELN; 
WRITELN( HEADER ) 

end; 

USErtORKFILE := CMDSTATE <> SYSPROG; 
WITH USERINFO DO 

IF USEWORKFILE THEN 
BEGIN 

IF GOTCODE THEN 

FNAME := CONCAT(CODEVID, ':•» CODETID) 
ELSE 

FNAME := »IN WORKSPACE'; 
SETUPFILE<0, USERHOST, FNAME); 
SETUPFlLEUt SYSTEMLIB* »*SYSTEM. LIBRARY* ) 
END 
ELSE 
BEGIN 

WRITE(*HOST FILE? ') ; 
READLN(FNAME) ; 
IF FNAME = •• THEN 
IF GOTCODE THEN 

FNAME J= CONCAT(CODEVIDi •:♦» CODETID) 
ELSE 

FNAME := »IN WORKSPACE'; 
SETUPFILE(0, USERHOSTi FNAME); 
IF ERRCOUNT > THEN 

EXIT(LINKER) 5 C NO HOST! I 
FOR F := 1 TO MAXFILE DO 
BEGIN 

WRlTEt'LlB FILE? •) ; 

READLN(FNAME) ; 

IF FNAME = •» THEN 

GOTO i; 
IF FNAME = •*• THEN 

SETUPFILE(F, SYSTEMLIB, • *SYSTEM. LIBRARY* ) 
ELSE 

SETUPFILE(F, 'JSERLIB. FNAME) 

end; 
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i: 

WRITE( 'MAP NAME? • ) ; 

READLN(MAPNAME) ? 

IF MAPNAME <> • • THEN 

IF MAPNAMECLENGTH(HAPNAME)3 = *.• THEN 
DELETEtMAPNAMEt LENGTH ( MAPNAME) » 1) 

ELSE 

insert< '.text*, mapname, length ( mapname )+l ) 
end; 

c now reverse list so host is j 
c first and syslib is last 3 

p := hostfile; hostfile := nil; 

REPEAT 

Q := P~.NEXT; 

p^.next := hostfile; 
hostfile := p; 
p := q 

UNTIL P = NIL; 
LI8FILES := HOSTFILE*. NEXT; 
END C BUILDFILELIST 3 ; 



c 

* 
* 
* 



buildseginfo initializes the seginfo table from 
the host prototype seg table. all legal states 
are checked, and imported units found. this 
leaves a list of all segs to finally appear in 
the output code file. 



PROCEDURE BUILDSEGINFO! 
LABEL 11 

var s: segindex; 
errs: integer; 
sp: segp; 

BEGIN 

WITH HOSTFILE*. SEGTBL DO 
FOR S := TO MAXSEG DO 
IF (SEGKINDCSD = LINKED) 
AND (DISKINFOCS1.CODELENG = 



0) THEN 
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SEGINFOCSII := NIL C NOT IN USE ] 

ELSE 

3egin c 00 something with seg 2 
errs := errcount; 

NEaMSP) ; 

SP^.SRCFILE := HOSTFILE; 
SP^.SRCSEG := S; 
SP^.SYMTAB := NIL; 
SP^.SEGKIND := SEGKINDCS3J 
CASE SP^.SEGKIND OF 
SEGPROC 



linked: 
hostseg: 



seprtseg: 



5 C NOTHING TO CHECK! 2 

IF S <> MASTERSEG THEN 
ERROR* »8AD HOST SEG») 

ELSE 

IF HOSTSP <> NIL THEN 

ERROR(»DUP HOST SEGM 
ELSE 

hostsp := sp; 

IF S = MASTERSEG THEN 

SP^.NEXT := NIL 
ELSE 

BEGIN C PUT INTO SEPLIST 1 
SP^.NEXT := SEPLIST; 
SEPLIST := SP; 
sp := NIL 
END; 



unitseg: 



IF DISKINF0CS3.C0DELENG = THEN 
SP*.SRCFILE := UNlTSRCH(LlBFILESt 

SEGNAMECS3* 

SP^.SRCSEG) 

END C CASES 1 ; 

IF ERRS = ERRCOUNT THEN 

SEGINFOCSJ := SP 
ELSE 

SEGINFOCSJ := NIL 

end; 
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C 'JOW FIND FIRST ASSIGNABLE SEG 2 

FOR S := FIRSTSEG TO MAXSEG 00 
IF SEGINFOCSU = NIL THE 1 ^ 
GOTO I? 
S := MAXSEGl! 
l: 

nextseg := s; 

IF SEGINFOCMASTERSEG: = NIL THEN 
ERRORCWEIRD HOST' ) 
END Z BUILDSEGIMFO 1 ; 



C 

* 
* 

* 
* 
* 



BUILDSEPLIST SEARCHES THROUGH LIBRARIES AND ADDS ONTO 
A GLOBAL LIST OF SEP SEGS THAT ARE TO BE SEARCHED 
FOR PROCS AND GLOBALS. THEY ARE INITIALLY BUILT IN 
THE REVERSE ORDER, THEN REVERSED AGAIN SO SEARCHES 
WILL GO IN THE ORDER THE FILES WERE SPECIFIED. 



PROCEDURE BUILDSEPLIST! 

VAR SP, p» q: segp; 
fp: FINFOP; 

s: segindex; 

BEGIN 

FP := LIBFILES; 
WHILE FP <> NIL DO 
BEGIN 

FOR S := TO MAXSEG DO 

IF FP^.SEGTBL.SEGKINDCSD = SEPRTSEG THEN 
BEGIN 



NEW(SP) 5 

SP'.NEXT := seplist; 
sp^.srcfile 
sp^.srcseg 
sp^.symtab 
sp^.segkind 
sp^.next := seplist; 
seplist := sp 
end; 
fp := fp^.next 



:= fp; 

= s; 

= nil; 

:= SEPRTSEG; 



819 1 20:2 66 ruo; 

320 1 20:2 91 

821 l 20: * 91 C NO* REVERSE THE LIST TO MAINTAIN ORIGINAL ORDER 3 

822 1 20:2 91 

823 1 2 °:i 91 p := seplist; seplist := nil; 

824 1 20:i 97 WHILE P <> NIL DO 

825 1 20:2 02. 3EGIN 

826 1 20:3 02 Q ;= p-.next; 

827 1 20:3 06 P^.NEXT := SEPLIST? 
8^8 1 20:3 11 SEPLIST := Pi 

829 1 20:3 14 P ;= Q 

830 1 20:2 14 EN D 

831 1 20:0 17 END C 8UILDSEPLIST 1 ; 

832 1 20:0 38 

833 1 15:0 BEGIN C PHASE1 1 

834 1 1510 

835 1 15:0 C INITIALIZE GLOBALS 1 

836 1 15:0 

337 1 15S1 HOSTFILE := NIL; 

838 1 15:i 3 LIBFILES := nil; 

839 1 15:1 6 HOSTSP : = nil; 
8*»0 1 15:1 9 seplist := nil; 

8ifl 1 15 !1 12 REFLITYPES := CUNITREF, GLObREF, PUBLREF» 

842 1 15:i 12 PRIVREF, CONSTREF. 

843 1 15:i 12 SEPPREF, SEPFREFD? 

844 1 15:i 20 ERRCOUNT ! = 01 

845 1 1511 23 NEXTBASELC := 3; 
8^6 1 15:i 31 MAPNAME := ••; 

8tf 7 1 1511 38 TALKATIVE ;= NOT USERINFO.SLOWTERM; 

848 1 15:i 44 MARK(HEAPBASE); 

849 1 15U 48 UNITWRITE<3, HEAPBASE", 35); 

850 1 15:i 56 

851 1 15:i 56 C DETERMINE BYTE SEX OF MACHINE 3 

852 1 1511 56 

853 1 15:i 56 FLIPPED := FALSE; 

854 1 1511 60 INT.VAL := II 

855 1 15:i 63 HIGHBYTE := 0RD( INT.BYTEC03 = 1 ); 

856 1 15!1 77 

857 1 15:i 77 C BUILD LIST OF INPUT FILES 3 

858 1 1511 77 

859 1 1511 77 BUILDFILELIST; 



489 



490 



860 
861 
862 
863 
864 
865 
866 
867 
868 
869 
870 
871 
872 
873 
874 
875 
876 
876 
877 
878 
879 
880 
881 
882 
883 
884 
885 
886 
887 
888 
889 
890 
891 
892 
893 
894 
895 
896 
897 
898 
899 



1 
1 
1 



lb 
15 
15 
15 
15 
1511 

15:1 
15:2 
15:2 
15:2 
15:2 
15:1 
15:1 
15:2 
15:0 
15:0 
15:0 
15:0 
15:0 
15:0 
15:0 
15:0 
15:0 
15:0 
15:0 
15:0 
15:0 
15:0 
15:0 
15:0 
15:0 
15:0 
15:0 
15:0 
15:0 
15:0 
is: o 
15:0 
2i:d 
2i:d 
2i:d 



79 
84 
88 
88 
88 
88 
90 
95 
99 
99 
99 
99 
01 
06 
10 
22 
22 
22 
22 
22 
22 
22 
22 
22 
22 
22 
22 
22 
22 
22 
22 
22 
22 
22 
22 
22 
22 
22 
1 
1 
2 



IF ERRCOUNT > THEN 
EXIT(LINKER) ? 

C INIT 3ASIC SEG INFO TABLE D 

BUILDSEGINFO; 
IF ERRCOUNT > THEN 
EXIT(LINKER); 

c finally build sep seg list 1 

buildseplist; 
if errcount > then 
exit(linker) 
end c phase1 3 5 

C$1 LINKl 1 
C$1 LINK2 1 

( ******************************************************************) 
(* *) 

(* COPYRIGHT (C) 1978 REGENTS OF THE UNIVERSITY OF CALIFORNIA. *) 
(* PERMISSION TO COPY OR DISTRIBUTE THIS SOFTWARE OR DOCUMEN- *) 
(* TATION IN HARD OR SOFT COPY GRANTED ONLY BY WRITTEN LICENSE *) 
(* OBTAINED FROM THE INSTITUTE FOR INFORMATION SYSTEMS. *) 

(* *) 

I******************************************************************) 



PHASE2 READS IN ALL LINKER INFO ASSOCIATED WITH 
THE SEGS IN SEGINFO AND SEP SEG LIST, AGAIN ALL 
FIELDS ARE CHECKED CAREFULLY. AS A HELP TO PHASE3, 
REF LISTS ARE COLLECTED AND PLACE RECORDS FOR SEP 
PROC/FUNC ARE COMPUTED. SOME SMALL OPTIMIZATION IS 
DONE TO ELIMINATE THE SEP SEG LIST IF IT IS NOT 
GOING TO BE NEEDEDt SAVING A FEW DISK IO'S. 



PROCEDURE PHASE2; 

var s: segindex; 
sp: segp; 
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DUvipSEPS: BOOLEAN; 



reaolinkinfo reads in the link info for segment sp 
amd builds its symtab. some simple disk 10 routines 
00 unblocking, and all fields are again verified, 
the only legal litypes are in oktypes. assume that 

SP <> NIL 



PROCEDURE READLINKINFOISP: SEGP; OKTYPES; LISET); 
VAR rp, rq: REFP' 
syp: symp; 

w. errsi nrecs, nextblk, recsleft: integer; 
ENTRY* temp: lientry; 

BUF: ARRAY CO. .313 OF 

ARRAY CO. .73 OF INTEGER; 

tentry: array C0..73 of integer; 



* GETENTRY READS AN 8 WORD RECORD FROM DISK BUF 

* SEQUENTIALLY. NO VALIDITY CHECKING IS DONE HEREt 

* ONLY DISK READ ERRORS. 
3 

procedure getentry(var entry: lientry); 
var err: boolean; 

BEGIN 

ERR := FALSE? 
IF RECSLEFT = THEN 
BEGIN 

RECSLEFT := 32; 

ERR := BLOCKREADCSP-.SRCFILE-.CODE*, BUF. 1, NEXTBLK) <> 1; 
IF ERR THEN 

ERRORCLI READ ERR») 
ELSE 

NEXTBLK := NEXTBLK+1 
END; 
M0VELEFT(BUFC32-RECSLEFT3, ENTRYt 16); 
IF ERR THEN 

ENTRY. LITYPE := EOFMARKJ 
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RECSLEFT := RECSLEFT-1 

END C GETENTRY D ; 



C 
* 
* 
* 
* 

3 



ADDUNIT IS CALLED TO FIND OR ALLOCATE A LIBRARY UNIT 
THAT IS FOUND IN LINK INFO AS AN EXTERNAL REF. THIS 
OCCURS IN LIB UNITS WHICH USE OTHER UNITS. IF 
THE UNIT CAN'T BE FOUND OR NO ROOM, ERROR IS CALLED. 



procedure addunit(var name: alpha)! 
var fp: finfop; seg: integer; 

3EGIN 

FP := UNITSRCHtHOSTFlLE, NAME* SEG); 
IF FP <> NIL THEN 

IF FP <> HOSTFILE THEN 

IF FP^.SEGTBL.OISKINFOCSEGD.CODELENG <> 
IF NEXTSEG = MAXSEGl THEN 

ERRORCNO ROOM IN SEGINFO' ) 
ELSE 

BEGIN C ALLOCATE NEW SEGINFO EL 3 
NEWCSEGINFOCNEXTSEG3) J 
WITH SEGINFOCNEXTSEG]* DO 
BEGIN 

srcfile := fp5 
srcseg := seg; 
segkind := unitseg; 
symtab := nil 

END; 
NEXTSEG := NEXTSEG+1 
END 
END C ADDUNIT 3 ; 



THEN 



C 

* 

* 



VALIDATE VERIFIES LIENTRY FORMAT. 

IF THE ENTRY IS SEPPROC OR FUNC 

THEN A PLACE REC IS ALLOCATED FOR BUlLDPLACE. IF 

A UNITREF IS FOUND, IT SEARCHED FOR AND POSSIBLY 

ALLOCATED. IF THE UNIT MUST BE ADDED TO SEGINFO, 

IT IS PLACED AFTER CURRENT POSITION SO IT WILL HAVE 

ITS LINK INFO READ AS WELL. 
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PROCEDURE VALIDATE(VAR ENTRY: LIENTRY); 
3EGIN 

WITH ENTRY DO 
IF NOT ALPHABE 
ERROR( 'NQN-A 
ELSE 

CASE LITYPE 
SEPPREF, 
SEPFREF, 
UNITREF, 
GLOBREF, 
PUBLREF, 
PRIVREF, 

constref: 



:tic{name> then 
u-pha name') 

OF 



globdef: 



publdef: 



EXTPROC, 

extfunc, 

SEPPROC. 



BEGIN 

REFLIST := NILJ 

IF (NREFS < 0) 

OR (NREFS > 500) THEN 

ERRORCTOO MANY REFS»)I 
IF NOT (FORMAT IN CWORD, BYTEi 

ERROR ('BAD FORMAT* )i 
IF LITYPE = PRIVREF THEN 
IF (NWORDS <s 0) 
OR (NWORDS > MAXLC) THEN 
ERROR(»BAD PRIVATE*) I 
IF LITYPE = UNITREF THEN 
IF NREFS <> THEN 
ADOUNIT(NAME) 
END? 

<= 0) 

> MAXPROC) 
< 0) 

> MAXIC) THEN 
GLOBDEF 1 ) ; 

IF (3ASE0FFSET <= 0) 
OR (3ASE0FFSET > MAXLC) THEN 
ERROR(»BAD PUBLICDEF* ) ; 



BIG3) THEN 



IF (HOMEPROC 
OR (HOMEPROC 
OR (ICOFFSET 
OR (ICOFFSET 
ERRORCBAO 
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sepfunc: 



END C CASE 
END C VALIDATE 1 



BEGIN 

IF LITYPE IN 
NEW (PLACE) 
ELSE 

PLACE := NIL; 
IF (SRCPROC <= 0) 
OR (SRCPROC > MAXPROC) 
OR (NPARAMS < 0) 
OR (NPARAMS > 100) THEN 
ERRORCBAD PROC/FUNCM 
END 
LITYPE D 



CSEPPROCtSEPFUNCD THEN 
C FOR USE IN BUILDPLACES 



BEGIN C READLINKINFO 3 

RECSLEFT := 0; C 8 WD RECS LEFT IN BUF 3 
WITH SP^.SRCFlLE^.SEGTBLi DISKINFOCSP^.SRCSEGD DO 
BEGIN C SEEK TO LINKINFO 3 

NEXTBLK := CODEADDR ♦ (CODELENG+511 ) DIV 512; 
IF TALKATIVE THEN 

WRITELN(»READING •» SEGNAMECSP*.SRCSEG3) 
END? 
REPEAT 

GETENTRY(ENTRY)? 

IF FLIPPED THEN C FLIP WORD QUANTITIES IN LIENTRY 3 

BEGIN 

MOVELEFT(ENTRY, TENTRY. 16)1 
FOR W := 4 TO 7 DO 

BYTESWAP(TENTRYCWD) i 
MOVELEFT(TENTRYf ENTRY* 16); 
END? 

ERRS := ERRCOUNT; 
IF ENTRY. LITYPE <> EOFMARK THEN 
IF ENTRY. LITYPE IN OKTYPES THEN 

VALIDATE(ENTRY) 
ELSE 
BEGIN 

ERROR(»BAD LITYPE») ; 
ENTRY. LITYPE := EOFMARK 
END? 
IF DUMPSEPS THEN 
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if entry. litype in useppref, sepfref* 

extproc, extfunc 
gl03refj then 
qumpseps := false; i we need them! 1 
IF entry. litype IN REFLITYPES THEN 
BEGIN C READ REF LIST 3 

NRECS := (ENTRY. NREFS+7) DIV 8; 
WHILE NRECS > DO 

BEGIN C READ REF REC ] 
GETENTRY(TEMP) ; 
NEW(RP) ; 

MOVELEFT(TEMP, RP^.REFS, 16); 
IF FLIPPED THEN C FLIP REF WORDS D 
FOR W := TO 7 DO 

BYTESWAP(RP A .REFSCW3) ; 
RP A .NEXT := ENTRY. REFLIST; 
ENTRY. REFLIST := RP; 
NRECS != NRECS-1 
END; 
C REVERSE REF LIST 1 
RP := ENTRY. REFLIST; 
ENTRY. REFLIST := NIL; 
WHILE RP <> NIL DO 
BEGIN 

rq := rp^.next; 

rp^.next := entry. reflist5 

entry. reflist := rp; 

RP := RQ 

END 
END! 
IF ENTRY. LITYPL = EOFMARK THEN 
IF SP^.SEGKIND = HOSTSEG THEN 
IF (ENTRY. NEXTLC > 0) 
AND (ENTRY. NEXTLC <= MAXLC) THEN 

NEXTBASELC := ENTRY. NEXTLC 
ELSE 

ERROR(»BAD HOST LC») 
ELSE 
ELSE 

IF ERRS = ERKCOUNT THEN 

BEGIN C OK. ..ADD TO SYMTAB 1 
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NEW(SYP) ! 

syp~. entry := entry; 
entersym(syp» sp*. symtab) 

END 
JNTIL ENTRY. LITYPE = EOFMARK 
ID C READLINKINFO 3 J 



3UILDPLACES READS CODE OF SEP SEGS FROM DISK TO GENERATE 
THE PLACEREC ENTRIES FOR USE DURING PHASE3. THE SEG IS 
READ INTO THE HEAP AND THE GROSSNESS BEGINS. ASSUME THAT 
SP <> NIL 



PROCEDURE BUILDPLACES(Sp: SEGP)5 
VAR CP: CODEP; HEAP: ^INTEGER; 

NBYTES. NBLOCKS, NPROCS* N: INTEGER; 



49cS 



* 
* 
* 
* 
3 



PROCSRCH RECURSIVLY SEARCHES SYMTAB OF SP TO FIND 
SEPPROC AND SEPFUNC ENTRIES AND BUILD THE ACTUAL 
PLACE RECORD FOR THE LINK INFO ENTRY BY INDEXING 
THRU PROC DICT TO JTAB AND USING ENTRIC FIELD. 



SYMP) 



PROCEDURE procsrch(symtab: 
var ii j: integer; 

BEGIN 

IF SYMTAB <> NIL THEN 
BEGIN 

PROCSRCH(SYMTAB*.LLINK) ? 
PROCSRCH(SYMTAB^.RLINK) ; 
PROCSRCH(SYMTAB A . SLINK) ; 
WITH SYMTAB*. ENTRY DO 

IF LITYPE IN CSEPPROCt SEPFUNC3 
IF (SRCPROC <= 0) OR (SRCPROC 

ERRORt 'BAD PROC «• ) 
ELSE C FIND BYTE PLACE IN CODE 3 
BEGIN 

I := NBYTES-2-2*SRCPR0C; 
I := I-FETCHWORDtCP, I); 



THEN 

> NPROCS) 



THEN 



POINT 
POINT 



AT 
AT 



PROC DICT 3 
JTAB 3 
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82 



IF (FETCH3YTE(CP» I) <> SRCPROC) 
AND (FETCHBYTEtCP. I) <> 0) THEN 

ERROR( 'DISAGREEING P •»•) 
ELSE 

BEGIN 

J := FETCHWORD(CP» I-2)+4; 

PLACE*. SRCBASE := I+2-Ji 

IF (PLACE*. SRCBASE < 0) 

OR (J <= 0) OR (J > MAXIC) THEN 

ERROR(»PROC PLACE ERR') 
ELSE 

PLACE*. LENGTH := J 
END 



END 



END 
END 
C PROCSRCH : 



BEGIN C BUILDPLACES 3 

NBYTES := SP*.SRCFILE*.SEGTBL.DISKINF0CSP*.SRCSEG3.C0DELENG{ 
NBLOCKS := (NBYTES+511) DIV 512; 
IF MEMAVAIL-400 < NBL0CKS*256 THEN 

ERROR(»SEP SEG 2 BlGM 
ELSE 

3EGIN C ALLOC SPACE IN HEAP 3 
MARK(HEAP) ; 
N := NBLOCKS? 
REPEAT 
NEW(CP) ; 
N := N-l 
UNTIL N <= 0! 
IF BL0CKREAD(SP*.SRCFILE~. CODE'S HEAP% NBLOCKS, 

SP*.SRCFILE*.SEGTBL.DISKINF0CSP*.SRCSEG3.C0DEADDR) 
ERR0R( f SEP SEG READ ERR') 
ELSE 
BEGIN 

CP := GETCODEP(ORD(HEAP)) ; 

NPROCS .*= FETCHBYTE(CP, NBYTES-1); 

IF (NPROCS < 0) OR (NPROCS > MAXPROC) THEN 

ERROR( *BAD PROC DICTM 
ELSE 

PROCSRCH (SP*.SY^TAB) 



<> NBLOCKS THEN 
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:98 



1197 
1180 
1189 
1190 
1191 
1192 
1193 
1194 
1195 
1196 
1197 
1198 
1199 
1200 
1201 
1202 
1203 
1204 
1205 
1206 
1207 
1208 
1209 
1210 
1211 
1212 
1213 
1214 
1215 
1216 
1217 
1218 
1219 
1220 
1221 
1222 
1223 
1224 
1225 
1226 
1227 



1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 



26 

26 

26 

26 

26 

21 

21 

21 

21 

21 

21 

21 

21 

21 

21 

2i:3 

21:3 

21 

21 

2113 

2i:4 

2H3 

2i:4 

21:3 

2i:3 

2i:3 

21:3 

2i:3 

2i:i 

2i:2 

2i:i 

21 

21 

21 

21 

21 



:4 
3 

2 

:o 
:o 
:o 
:o 
;i 
;i 
;i 
:i 
;i 
11 
:i 

!2 



;3 
;4 



21:2 
21:2 
21:2 
21:1 
21:2 



81 
86 
88 
90 
06 



4 
12 
12 
12 
12 
15 
32 
45 
57 
59 
68 
78 
87 
97 
06 
16 
31 
59 
59 
59 
59 
62 
65 
68 
73 
73 
85 
86 
91 
91 
91 
91 
05 



end; 
release(heap) 

END 
END C BUILDPLACES 3 5 

BEGIN L PHASE2 1 

MARK < HEAPBA.SE> ; 
UNITWRITE(3» HEAPBASE*, 35) 5 

C READ LINK INFO FOR HOST SEGS D 

DUMPSEPS := TRUE? C ASSUME WE DON'T NEED SEP SEGS 3 
FOR S := TO MAXSEG DO 

IF SEGlNFOCSD <> NIL THEN 

CASE SEGINFOCS:T»SEGKIND OF 

linked: ; c nothin i 

UNITSEG: READLINKINF0(SEGINF0CS3» cpublref» privref. unitref, 

J * constdef.extproc extfuncdji 

SEPRTSEG: READLINKINF0(SEGINF0CS3» CGLOBREF* GLOBDEFt CONSTDEF* 

SEPPROCi SEPFUNC3); 

HOSTSEG: READLINKINF0(SEGINF0CS3» cpubldef, constdef. 

EXTPROC, EXTFUNC3)5 

SEGPROC: READLINKINF0(SEGINF0CS3. CEXTPROC. EXTFUNC3) 
END C CASES 1 ! 

C NOW DO SEP LIST ELEMENTS 1 

IF DUMPSEPS THEN 

seplist := nil; 
sp := seplist; 
while sp nil do 

READLINKINFOtSP. REFLlTYPES+CGLOBDEF* CONSTDEF. SEPPROC. SEPFUNCD) 

sp := sp".next 

end; 

C BUILD PROC PLACE ENTRIES FOR SEP SEGS 1 

IF SEGINFOCMASTERSEGD^.SEGKIND = SEPRTSEG THEN 
BUILDPLACES (SEGIMFOCMASTERSEG 3) ; 



1223 1 21 :2 16 

1229 i 21:1 ib sp := seplist; 

1230 1 21 :i 19 WHILE SP <> NIL DO 

1231 1 2i:2 24 BEGIN 

1232 l 21.-3 24 SUILDPLACES(SP); 

1233 1 21:3 27 S P := SP^.fJEXT 

1234 1 21:2 26 END; 

1235 1 21U 33 IF ERRCOUNT > THEN 

1236 1 21.-2 38 EXIT(LINKER) 

1237 1 2i:o 42 END C PHASE2 1 ; 
1233 1 2i:o 60 

1239 1 21:0 60 C$1 LINK2 J 

1239 1 2i:o 60 C$1 LINK3A J 

1240 1 2i:o 60 

J?!*l 1 2l:o 60 <***********************************************************♦*♦****) 

1242 1 2l:o 60 {* ' 

"S J 21:0 60 (* COPYRIGHT (C) 1978 REGENTS OF THE UNIVERSITY OF CALIFORNIA. *) 

J J *i:o 60 (* PERMISSION TO COPY OR DISTRIBUTE THIS SOFTWARE OR DOCUMEN- *) 

10a? J" ?, 60 ( * T A TI0N IN H ARD OR SOFT COPY GRANTED ONLY BY WRITTEN LICENSE *) 

1246 1 21:0 60 {* OBTAINED FROM THE INSTITUTE FOR INFORMATION SYSTEMS. *) 

1247 1 21:0 60 (* m) 

J'oao 1 21 |° 6 ° <***********************************************************♦****♦*) 

1249 1 21 J 60 

1250 1 2i:o 60 c 

1251 1 2i:o 60 * PHASE3 OF THE LINKER DOES ALL THE REAL WORK OF CODE 

1252 1 2i:o 60 * MASSAGING, FOR EACH SEGMENT IN SEGINFO TO BE PLACED 

1253 1 2i:o 60 * INTO THE OUTPUT CODE FlLEi ALL REFERENCED PROCEDURES 

1254 1 21:0 60 * AND FUNCTIONS ARE FOUND. GL03ALS AND OTHER REFS ARE 

1255 1 21:0 60 * RESOLVED. AND FINALLY THE FINAL CODE SEGMENT IS BUILT. 

Hit X 21: ° 6 ° * IN THE CASE 0F A SEPRTSEG HOST (EG AN INTERPRETER), THEN 

1257 1 2i:o 60 * ALL THE PROCS IN IT ARE PUT IN THE UNRESOLVED LIST AND 

1258 1 2i:o 60 * THE HOST SEG IS MADE TO APPEAR AS JUST ANOTHER SEP SEG. 

1259 1 2i:0 60 * THIS DRAGS ALONG ALL THE ORIGINAL PROCEDURES AND MAINTAINS 
12o0 1 21:0 60 * THEIR ORIGINAL ORDERING FOR POSSIBLE ASECT INTEGRITY. 

1261 1 2i:o 60 2 

1262 1 2i:o 60 

1263 1 28:d 1 PROCEDURE PHASE35 

1264 1 28!D 1 TYPE 

Htl } 2 ,V° 1 W0RKP = " w O RK REC; C ALL SEG WORK IS DRIVEN BY THESE LISTS 3 

1266 1 28.*Q 1 WORKREC = RECORD 

1267 1 28:d 1 NEXT? WORKP; C LIST LINK D 
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1266 

1269 

1270 

1271 

1272 

1273 

1274 

1275 

1276 

1277 

1278 

1279 

1280 

1281 

1282 

1283 

1284 

1285 

1286 

1287 

1288 

1289 

1290 

1291 

1292 

1293 

1294 

1295 

1296 

1297 

1298 

1299 

1300 

1301 

1302 

1303 

1304 

1305 

1306 

1307 

1308 



1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 



28:0 

26 :d 
28 :d 
28JD 



28 
26 
26 
28 

2a:o 

26!D 

28:d 
28:d 
28 :d 
2s:d 
2b:d 
28:o 
28:d 
26:d 
28:o 
28:d 
28:d 
28:d 
28:d 
28 :q 
28:d 
28:d 
28:d 
28:d 
28 :d 
28:d 
28:d 
28:d 

28ID 

28:d 
28:d 
28:d 
28:d 
28 :d 
28:d 
28:d 
28:d 



1 
1 
1 
1 
1 
1 
1 
1 
1 
1 

X 

1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
1 

2 
3 
3 

5 
5 
5 
5 
5 
5 

11 

12 

32 
88 
89 
89 
69 
89 
89 
69 



VAR 



REFSYM, c SY 

uefsym: symp; c 

refseg, c se 

defseg: segp; : se 

case litypes of c sa 

SEPPREF, 
SEPFREF, 

globref: 

(DEFPROC: 
UNITREF: 

(defsegnum: 
privref: 

(newoffset: 

EXTPROCt 
EXTFUNCt 
SEPPROC, 

sepfunc: 

(needsrch: boolean? 
newproc: 0..maxproc 
end c workrec 3 ; 



3 JJ 

MTAB ENTRY OF UNRESOLVED NAME 1 
" " " RESOLVING ENTRY 3 
G REFLS POINT INTOi REFRANGE ONLY 
G WHERE DEFSYM WAS FOUND 3 
ME AS LITYPE IN REFSYM~. ENTRY 3 



WORKP); C WORK ITEM OF HOMEPROC 3 
SEGRANGE); C RESOLVED SEG 8, DEF = REF 3 
LCRANGE); C NEWLY ASSIGNED BASE OFFSET 3 



C REFS HAVEN»T BEEN FOUND 3 
) C PROC #t COMP OR LINK CHOSEN 
C IMPLIES ADDED PROC 3 



s: segindex; 

SEGBASEI CODEP; c 

segleng, c 

nextblk: integer' c 

UPROCSt C 

PROCS. C 

ULOCAL, C 

LOCAL, C 

UOTHER, C 

other: workp; c 

sephost: boolean; c 

fname: STRINGC39J;t: 

segt3l: i5segtbl5 c 

map: text; c 



ADDRESS OF CURRENT SEG BEING CRUNCHED 2 

FINAL CODE SEG LENGTH FOR WRITEOUT 3 

NEXT AVAILABLE OUTPUT CODE BLOCK 3 

UNRESOLVED EXTERNAL PROC/FUNC WORK LIST 1 

RESOLVED LIST OF ABOVE ITEMS 3 

UNRESOLVED LIST OF UPDATES FOR SEGINFO ENTRY 3 

RESOLVED LIST OF FIXUPS THAT CAME ALONG WITH SEG 3 

UNRESOLVED WORK LIST OF THINGS OTHER THAN PROCS 3 

RESOLVED LIST OF ABOVE 3 

FLAG FOR INTERPRETER HOST CASE (ONLY SEG *1> 3 

OUTPUT CODE FILE NAME 3 

OUTPUT CODE»S SEG TABLE 3 

MAP TEXT OUTPUT FILE 3 



C 

* 
* 
* 
* 



BUILDWORKLISTS IS CALLED FOR ALL SEGMENTS WHICH NEED TO 
3E COPIED, AND MAYBE NEED TO HAVE SEPPROCS OR OTHERS STUFF 
FIXED UP WITHIN THEM. THE IDEA HERE IS TO GET A LIST 
OF PROCS AND OTHER ITEM NEEDING ATTENTION, WITH 



1309 

1310 

1311 

1312 

1313 

131H 

1315 

1316 

1317 

1318 

1319 

1320 

1321 

1322 

1323 

1324 

1325 

1326 

1327 

1328 

1329 

1330 

1331 

1332 

1333 

1334 

1335 

1336 

1337 

1338 

1339 

1340 

1341 

1342 

1343 

1344 

1345 

1346 

1347 

1348 

1349 



1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 



23 


:o 


23 


:d 


28 


:d 


28 


: o 


28 


• U 


28 


:o 


28 


:d 


28 


:o 


28 


:d 


28 


:d 


28 


:d 


29 


:d 


29 


ID 


29 


:d 


29 


:d 


29 


:d 


29 


:d 


29 


:d 


29 


:d 


29 


:d 


29 


:d 


29; 


.D 


291 


.0 


30 


.0 


30! 


>D 


30! 


'0 


30! 


D 


30; 


D 


30! 


D 


3o: 


D 


30: 


D 


3o: 


D 


3i; 


D 


31! 


D 


3i: 





3i: 


1 


3i: 


2 


3i : 


3 


3i: 


3 


31 : 


3 


3i.: 


3 



59 

89 

39 

39 

89 

39 

39 

89 

69 

89 

39 

1 

1 

2 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

5 

6 

6 

6 

6 

6 

6 

6 

1 

2 





5 

5 

9 

13 

17 



* 
* 

* 

* 
* 
* 
J 



all the subtle implications of global defs falling 
in procs which are not yet selected for linking etc. 
in fact, three lists are built: 

the procs list ^jlth all procs and func to be grabbed 

FROM THE VARIOUS SEP segs. 

THE LOCAL LIST OF REFS IN THE ORIGINAL SEGMENT WHICH MUST 
UP SUCH AS PUBLIC OR PRIVATE REFS IN A UNIT SEG. 
LIST WHICH HAS WORK ITEMS WHICH HAVE AT LEAST ONE 
IN THE PROCS OR FUNCS IN THE PROCS LIST. 



ALL BE FIXED 
THE OTHER 

REF occuring 



PROCEDURE 
VAR SP: 

wp: 



BUILDWORKLISTS; 

segp; 

WORKP; 



c 

* 
* 
* 
* 
2 



FINDPROCS GOES THROUGH SYMTAB AND BUILDS A LIST OF 
PROCEDURE AND FUNCTIONS WHICH OCCUR IN THE TREE AND 
WHOSE LITYPE IS IN THE OKSET. THE RESULTING LIST 
IS NOT ORDERED IN ANY PARTICULAR FASHION. IT IS 
CALLED TO BUILD INITIAL UPROC LIST. 



FUNCTION findprocs<okset: liset; symtab: sympj: workp; 
var work: workp; 

c 

* PROCSRCH RECURSIVLY SEARCHES SUBTREES TO PICK OUT 

* THOSE SYMBOLS WHICH ARE IN THE OKSET, GENERATES 

* NEW WORK NODES, AND PUTS THEM INTO LOCAL WORK LIST. 

PROCEDURE PROCSRCH(SYM: SYMP) ; 

VAR WP; workp; 
BEGIN 

IF SYM <> NIL THEN 
BEGIN 

procsrch<sym~.llink) ; 
procsrch(sym%rlink) ; 
procsrch(sym". slink) ; 
if sym~. entry. litype in okset then 
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_n 



32 



1350 


1 


31:4 


26 


1351 


1 


31:5 


56 


1352 


1 


3i:s 


31 


1353 


1 


3i:s 


36 


1354 


1 


3i:s 


41 


1355 


1 


31:5 


^6 


1356 


1 


31:5 


51 


1357 


1 


31:5 


56 


1358 


1 


3i:b 


61 


1359 


1 


31:5 


64 


1360 


1 


3i:6 


73 


1361 


1 


3115 


65 


1362 


1 


31:5 


90 


1363 


1 


31:4 


90 


1364 


1 


31:2 


94 


1365 


1 


31:0 


94 


1366 


1 


31 :o 


06 


1367 


1 


30:0 





1368 


1 


3o;i 





1369 


1 


30:1 


3 


1370 


1 


30:1 


6 


1371 


1 


30:0 


6 


1372 


1 


30:0 


22 


1373 


1 


30:0 


22 


1374 


1 


30:0 


22 


1375 


1 


30:0 


22 


1376 


1 


30 :o 


22 


1377 


1 


30:0 


22 


1378 


1 


30:0 


22 


1379 


1 


30:0 


22 


1380 


1 


30:0 


22 


1381 


1 


30:0 


22 


1382 


1 


32:d 


1 


1383 


1 


32:d 


1 


1384 


1 


32:0 


3 


1385 


1 


32:d 


<+ 


1386 


1 


32:d 


4 


1387 


1 


32:0 


4 


1388 


1 


32:0 


4 


1389 


1 


32 :d 


<+ 


1390 


1 


32!D 


4 



sym; 
nil; 
nil; 
nil; 
= true; 



BEGIN C PLACE NEW NODE IN LIST 3 
NEW(WP) ; 
WP A .REFSYM 
WP^.REFSES 
WP^.DEFSYM 
WP^.DEFSES 
WP^.NEEDSRCH 
IF SEPHOST THEN 

WP*,NEWPROC := 
ELSE 

wp^.newproc := sym a . entry. srcproc! 
wp^.next := wiork; 
work := WP 

END 



C SEE READSRCSEG! 1 



END 
END C PROCSRCH ! 

3EGIN C FINDPROCS D 

WORK := NIL? 

PROCSRCH(SYMTAB) ! 

FINDPROCS ;= WORK 
END C FINDPROCS 3 5 



C 

* 
* 

* 
* 



FINDNEWPROCS IS CALLED TO PLACE NEW PROCEDURES INTO THE 
UPROCS WORK LIST THAT ARE NEEDED TO RESOLVE GLOBDEFS* 
SEPPREFS, AND SEPFREFS. THE OTHER LIST IS TRAVERSED AND 
FOR EACH ELEMENT WHOSE DEFINING PROC HAS NOT BEEN ADDED 
INTO THE UPROCS LIST* THE DEFINING PROC IS LOCATED AND 
ADDED INTO UPROCS. 



PROCEDURE FINDNEWPROCS; 
VAR WPt WPi: WORKP! 

pnum: integer; 

c 

* FINDNADU FINDS THE PROCEDURE NUMBERED PNUM IN THE 

* SYMBOL TABLE SYMTAB. AN ERROR IS GIVEN IF THE 

* REQUIRED PROC CANNOT BE FOUND. IT RETURNS A WORK 

* NODE FOR THE PROC ONCE IT HAS BEEN FOUND. THIS 



1391 


i 


32 :n 


4 


13 92 


1 


32: r j 


4 


1393 


1 


32:d 


<+ 


1394 


1 


32: j 


4 


1395 


1 


32:d 


4 


1396 


1 


33: Li 


3 


1397 


i 


33: D 


4 


1396 


1 


33:j 


4 


1399 


1 


33 :d 


4 


1400 


1 


33 :o 


4 


1401 


1 


33 :d 


4 


1402 


1 


33:o 


4 


1403 


1 


33:d 


4 


1404 


1 


34ID 


1 


1405 


1 


34:d 


2 


1406 


1 


34:0 





1407 


1 


34:1 





1408 


1 


34:2 


5 


1409 


1 


34:3 


5 


1410 


1 


34:3 


9 


1411 


1 


34:3 


13 


1412 


1 


34:3 


17 


1413 


1 


34:4 


26 


1414 


1 


34:5 


35 


1415 


1 


3416 


35 


1416 


1 


3416 


40 


1417 


1 


34:7 


45 


1418 


1 


34:8 


45 


1419 


1 


34:9 


51 


1420 


1 


34:0 


51 


1421 


1 


34:0 


55 


1422 


1 


34:9 


59 


1423 


1 


34:8 


59 


1424 


1 


34:7 


60 


1425 


1 


34:6 


65 


1426 


1 


34:6 


70 


1427 


1 


34:6 


75 


1428 


1 


34:6 


80 


1429 


1 


34:6 


85 


1430 


1 


34:6 


90 


1431 


1 


34:6 


95 



* 

* 
* 

1 



NODE IS ALSO ADDED INTO THE UPROCS LIST. ANY PROCS 
ADDED THIS WAY ARE "INVISIBLE", DRAGGED ALONG BECAUSE 
OF GLOBAL REFS/DEFS. 



function findnaddjsymtab: symp): workp; 



* PROCSRCH KECURSIVLY SEARCHES THE SYM TREE LOOKING 

* FOR THE ACTUAL SYMBOL CONTAINING PNUM. THIS DOES 

* - - - - - ~ - - ■ • 

1 



VIOST OF THE WORK OF FlNDNADD. 



PROCEDURE PROCSRCH(SYM: SYMP); 

VAR wp; workp; 

BEGIN 

IF SYM <> NIL THEN 
BEGIN 

procsrch<sym%llink) ; 
procsrch(sym^.rlink) ; 
procsrchtsym^.slink) 5 

IF SYM'*. ENTRY. LITYPE IN CSEPPROCt SEPFUNC3 THEN 
IF SYM*. ENTRY. SRCPROC = PNUM THEN 
BEGIN 

WP := UPROCS; 
WHILE WP <> NIL DO 
BEGIN 

IF WP^.REFSYM = SYM THEN 
BEGIN 

findnadd := wpj 
exit(findnadd) 

END; 
WP := WP~,NEXT 

END; 



NEW(WP); 
WP^.REFSYM :: 
WP~.REFSEG I: 
WP^.DEFSYM I: 
WP~.DEFSEG I: 
WP^.NEEDSRCH 
WP^.NEWPROC 



SYM; 
nil; 
nil; 

NIL? 

:= TRUE; 
= 0; 
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1432 


1 


34:& 


U5 


1433 


1 


3416 


10 


1434 


1 


34:& 


14 


1435 


1 


3426 


18 


1436 


1 


34:5 


22 


1437 


1 


34:2 


22 


1438 


1 


34:0 


22 


1439 


1 


34:0 


36 


1440 


1 


33:0 





1441 


1 


33:i 





1442 


1 


33:1 


3 


1443 


1 


33:1 


6 


1444 


1 


33:1 


6 


1445 


1 


33:o 


21 


1446 


1 


33:0 


36 


1447 


1 


32:0 





1448 


1 


32 :i 





1449 


1 


32:1 


5 


1450 


1 


32:2 


10 


1451 


1 


32:3 


10 


1452 


1 


32:4 


16 


1453 


1 


32:5 


16 


1454 


1 


32:6 


23 


1455 


1 


32:5 


25 


1456 


1 


32:6 


31 


1457 


1 


32:5 


37 


1458 


1 


32:5 


42 


1459 


1 


32:6 


47 


1460 


1 


32:7 


54 


1461 


1 


32:8 


62 


1462 


1 


32:9 


62 


1463 


1 


32:9 


67 


1464 


1 


32:8 


67 


1465 


1 


32:7 


70 


1466 


1 


32:8 


72 


1467 


1 


32:6 


73 


1468 


1 


32:7 


78 


1469 


1 


32:5 


84 


1470 


1 


32:6 


90 


1471 


1 


32:4 


96 


1472 


1 


32:3 


01 



WP*.NEXT := uprocs; 
UPROCS := WP; 
finqnadd := WP? 

EXIT(FINDNADD) 

END 



END 
END c PROCSRCH 1 J 

BEGIN C FINDNADD 1 
FINDNADD := NIL; 
PROCSRCH(SYMTAB) 5 
C IF WE GET HERE THEN 
ERROR( 'MISSING PRQCM 

END C FINDNADD 1 ', 



DIDNT FIND IT 2 



begin c findnewprocs d 
wp := other; c a 
while wp <> nil do 

BEGIN 

IF WP A .DEFPROC = 

BEGIN C FIND PR 

IF WP^.REFSYM 

PNUM := WP* 

ELSE C ASSUME 

PNUM := WP~ 

wpi := procs; 
while wpi <> 
if wp^.defs 

IF WP1 A .D 
BEGIN C 
WP A .D 
WPI : 
END 
ELSE 
WPI : = 
ELSE 

wpi := wp 

if wp^.oefpro 
wp".defproc 

END; 

WP := wp'.next 



SSUME ONLY GLOBREF* SEPPREFi SEPFREF IN LIST 3 



NIL THEN 

OC/FUNC NEEDED 3 

*. ENTRY. LITYPE = GLOBREF THEN 

.OEFSYM*. ENTRY. HOMEPROC 

A SEP PROC/FUNC 3 
.DEFSYM^.ENTRY.SRCPROC; 

NIL DO 

EG = WPl^.DEFSEG THEN 

EFSYM*. ENTRY. SRCPROC = PNUM THEN 

ALREADY GONNA BE LINKED 3 
EFPROC := WPI I 
= NIL 



WPl^.NEXT 

i^.next; 

c = nil then c forcibly link it 3 
;= findnadd ( wp~.defseg~.symtab) 
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END C Air-lilt : 
ENO l FINDNEwPHOCS 
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resolve: removes work items from inlist, searches symtabs 

FOR ITS CORRESPONDING DEFINITION SYMBOL (ERROR IF NOT FOUND), 
AND MOVES THE WORK ITEM INTO THE OUTPUT LIST. EACH FLAVOR 
OF WORK ITEM NEEOS SOME SPECIAL HANDLING TO COLLECT EXTRA 
INFO RELATED To SPECIFIC THINGS. IN GENERAL, DEFSYM AND 
DEFSEG ARE FILLED IN. THE INSERT ALGORITHM IS SPECIAL FOR 
PROCEDURE TYPES TO MAKE LIFE EASIER ON REFSRCH. 



PROCEDURE RESOLVE(VAR INLIST, OUTLIST: WORKP); 
VAR seg: SEGRANGE; 

err: boolean; 
wp: workp; 



c 
* 
* 

* 
* 
* 
3 



SEPSRCH SEQUENTIALLY SEARCH THE SYMTABS IN THE SEPLIST 
TO RESOLVE THE REFSYM OF INLIST*. IT BASICALLY JUST 
CALLS SYMSRCH REPETIVELY AND FIXES UP DEFSYM AND 
DEFSEG FIELDS. IF THE NAME OF THE REFSYM COULD 
NOT BE FOUND, AN ERROR IS GIVEN. 



PROCEDURE sepsrch<oktype: LITYPESM 
var syp: symp; 
sp; segp; 

BEGIN 

sp := SEPLIST; 
WHILE SP <> NIL DO 
BEGIN 

SYP := SYMSRCHdNLIST*. REFSYM*. ENTRY. NAME, 

OKTYPE, SP-.SYMTAB); 
IF SYP <> NIL THEN 
BEGIN 

INLIST*. DEFSYM := SYP; 
INLIST*. DEFSEG := SP; 
SP := NIL 
END 
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ELSE 

SP := SP*.NEXT 

END 
END I SEPSRCH 1 ! 



* 
* 
* 

1 



PROCINSERT IS CALLED TO INSERT WORK INTO THE PROCS 
LIST USING A SPECIAL SET OF SORT KEYS SO THAT COPYIN- 
PROCS WILL RUN REASONABLY FAST AND USE THE DISK 
EFFICIENTLY. THE PROCS LIST IS SORTED BY SEGMENT, 
SRCBASE KEYS. THE SEG ORDERING IS DICTATED BY THE 
SEPLIST. SO USER ASECTS ETC WILL RETAIN THEIR ORIGINAL 
ORDERING. 



PROCEDURE PR0CINSERT(W0RK: WORKP); 
LABEL is 

VAR CRNT» PREV: WORKPl 
SP: SEGP5 
BEGIN 

PREV := NIL? 
SP := SEPLISTI 

WHILE SP <> 0UTLIST A .DEFSEG DO 
IF SP = WORK^.DEFSEG THEN 

GOTO 1 
ELSE 

sp := sp*.next; 

CRNT := OUTLIST; 

REPEAT 

IF CRNT*.DEFSEG = WORK*.DEFSEG THEN 
REPEAT 

IF WORK~.DEFSYM*. ENTRY. PLACE*. SRCBASE < 

CRNT*. DEFSYM*. ENTRY. PLACE*. SRCBASE THEN 

GOTO i; 
PREV := CRNT? 
CRNT := CRNT*. NEXT? 
IF CRNT = NIL THEN 
GOTO 1 
UNTIL CRNT*.DEFSEG <> WORK*.DEFSEG 
ELSE 
BEGIN 
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prev := crnt; 

CRNT := CRNT*. NEXT I 
IF CRNT <> NIL THEN 

WHILE SP <> CRNT*.DEFSEG DO 
IF SP = aIQRK^.DEFSEG THEN 

GOTO 1 
ELSE 

SP := SP".NEXT 
END 
UNTIL CRNT = NIL; 
i: 

IF PREV = NIL THEN 
BEGIN 

WORK". NEXT := OUTLIST; 
OJTLIST := WORK 
END 
ELSE 
BEGIN 

WORK". NEXT := PREV". NEXT? 
PREV". NEXT := WORK 
END 
END C PROCINSERT 2 5 

3EGIN C RESOLVE 2 

WHILE INLIST <> NIL DO 
BEGIN 

WITH INLIST"* REFSYM*. ENTRY DO 
CASE LITYPE OF 

globref: begin 

sepsrch(globdef); 
defproc ;= nil 

END; 

constref: if hostsp o nil then 

BEGIN 

defsym := symsrch(name* constdef. 

hostsp". symtab); 
defseg := hostsp 

END; 
PUBLKEF: IF HOSTSP <> NIL THEN 
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PRIVKEF: 



EXTPROCt 
SEPPKOC, 

seppref: 



EXTFUNC, 
SEPFUNC. 

sepfkef: 



BEGIN 

DEFSYM := SYMSRCHtNAMEi PUBLDEF, 
H0STSP~.SYMTA3) 5 

DEFSEG := HOSTSP 
END! 

BEGIN 

NEWOFFSET := NEXTBASELC; 

NEXTBASELC := NEXTBASELC+NWORDS ; 

IF HOSTSP <> NIL THEN 
QEFSYM ;= REFSYM; 

DEFSEG := HOSTSP 
END; 



BEGIN 

SEPSRCH(SEPPROC) ; 

IF LITYPE = SEPPREF THEN 

DEFPROC := NIL; 
ERR := FALSE; 
IF DEFSYM <> NIL THEN 

IF LITYPE = SEPPREF THEN 

ERR := DEFSYM". ENTRY. NPARAMS <> NWORDS 
ELSE 

ERR := DEFSYM*. ENTRY. NPARAMS <> NPARAMS; 
IF ERR THEN 
BEGIN 

WRITECPROC •» NAME); 
ERRORC PARAM MISMATCH*) 
END 
END; 



BEGIN 

SEPSRCH(SEPFUNC); 

IF LITYPE = SEPFREF THEN 

DEFPROC := NIL; 
ERR := FALSE; 
IF DEFSYM <> NIL THEN 

IF LITYPE = SEPFREF THEN 

ERR := DEFSYM". ENTRY. NPARAMS <> NWORDS 



1637 


1 


3517 


46 


1656 


1 


3d:b 


55 


1639 


1 


3516 


34 


164Q 


1 


35:7 


6 7 


1641 


1 


35:3 


67 


1642 


1 


35:d 


91 


1643 


1 


35:7 


09 


1644 


1 


35:5 


11 


1645 


1 


35:5 


13 


1646 


1 


35:4 


13 


1647 


1 


35:6 


25 


1643 


1 


35:7 


25 


1649 


1 


35:7 


31 


1650 


1 


35:& 


34 


1651 


1 


35:5 


39 


1652 


1 


35:6 


41 


1653 


1 


35:4 


52 


1654 


1 


35:4 


92 


1655 


1 


35:3 


92 


1656 


1 


35:3 


96 


1657 


1 


35:3 


00 


1658 


1 


35:4 


06 


1659 


1 


35:5 


12 


1660 


1 


35:6 


12 


1661 


1 


35:6 


16 


1662 


1 


35:6 


35 


1663 


1 


35:6 


54 


1664 


1 


35:& 


72 


1665 


1 


35:6 


72 


1666 


1 


35:6 


89 


1667 


1 


35:& 


89 


1668 


1 


35:6 


04 


1669 


1 


35:6 


40 


1670 


1 


35:6 


49 


1671 


1 


35:5 


62 


1672 


1 


35:3 


64 


1673 


1 


35:4 


66 


1674 


1 


35:4 


74 


1675 


1 


35:5 


81 


1676 


1 


35:4 


62 


1677 


1 


35:5 


86 



else 
err := defsym*. entry. nparams <> nparams; 
if err then 

6EGIN 

WRITECFUNC ♦. NAME); 
ERRORC PARAM MISMATCH 1 ) 

END 
END; 

UNITREF: IF UNITSRCHtHOSTFlLE* NAME, SE6) = HOSTFILE THEN 
BEGIN C WILL BE FOUND IN HOST 1 
DEFSYM := REFSYM; 
DEFSEGNUM := SEG 

END 

else c "impossible" d 
errorcunit err 1 ) 
end c cases 1 5 

wp := inlist; 
inlist := wp^.next; 

IF WP~. DEFSYM = NIL THEN 
WITH WP^.REFSYM*. ENTRY DO 
BEGIN 

case litype of 

globref: writef global • >; 

publref: writecpublic ♦); 

constref: writecconst mi 

SEPPREF, 

EXTPROC: WRITECPROC »)5 
SEPFREF, 

EXTFUNC: WRITECFUNC •) 
END C CASES 3 ; 
WRITE(NAME); 
ERROR(» UNDEFINED') 
END 
ELSE 

IF (WP*. DEFSYM*. ENTRY. LITYPE IN CSEPPROCt SEPFUNC3) 
AND (OUTLIST <> NIL) THEN 

PROCINSERT(WP) 
ELSE 
BEGIN 
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END 

C 
* 

* 

* 
* 

* 
* 

3 



UP*. next := outlist; 

OUTLIST := WP 

END 
END C WHILE 1 
C RESOLVE J ? 



REFSRCH SLOWLY GOES THROUGH ALL REFERENCE LISTS IN SYMBOLS 
WHICH ARE IN THE OkSET TO SEE IF ANY "OCCUR" WITHIN THE 
PROCEDURES/FUNCTIONS SELECTED TO BE LINKED, THAT IS CONTAINED 
IN PROCS LIST. IT IS ASSUMED THAT PROCS IS SORTED BY DEFSEG 
SO ONLY THE PROCS BETWEEN IPL AND LPL ARE SEARCHED. 
ANY SYMBOLS WHICH HAVE ANY REFS IN SELECTED PROCS ARE GIVEN 
WORK NODES AND ARE PLACED IN THE UOTHER LIST IN NO CERTAIN 
ORDER SO RESOLVE CAN BE CALLED RIGHT AWAY. 



procedure refsRch(Okset: liset; sp: segp>; 
var lpl, ipl: workpj 
diffseg: boolean; 



c 

* 
* 
* 
* 
# 

1 



CHECKREFS RECURSIVLY SEARCHES SYM TREE TO KIND NAMES 
IN THE OKSET. WHEN ONE IS FOUND, EACH OF ITS REF POINTERS 
ARE CHECKED TO SEE IF THEY FALL IN ONE OF THE PROCS 
TO-BE-LINKED (BETWEEN IPL & LPL). IF SO, A NEW WORK ITEM 
IS GENERATED AND IT'S PUT ON THE UOTHER LIST. 



PROCEDURE CHECKREFS(SYM: SYMP); 
LABEL 1, 2? 

var pl, wp; workp; 

It n, ref: integer; 
rp: kefp; 

BEGIN 

IF SYM <> NIL THEN 
BEGIN 

checkrefs(Sym-.llink) ; 
checkrefS(Sym~.rlink> ; 
checkrefs(sym~. slink) i 
with sym*. entry do 
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IF LITYPE I'M OKSET THEN 
BEGIN 

N := imrefs; 

Rp 1= REFLIST; 
rtHlLE RD <> |\jil do 
BEGIN 

IF M > 8 THEN 
3EGIN 

I := 7; 

N := N-8 

END 
ELSE 

1 := n-i; 

REPEAT C FOR EACH REF D 
REF := RP^.REFSCn? 

pl := ipl; 

REPEAT C SEARCH PROC LIST 1 
IF PL^.NEEDSRCH THEN 

WITH PL A .DEFSYM' S . ENTRY. PLACE- DO 
IF REF < SRCBASE THEN 

GOTO 2 C TERMINATE PROC SEARCH 1 
ELSE 

IF REF < SRCBASE+LENGTH THEN 
BEGIN C OCCURS IN PROC 1 
NEW(WP) ; 

wp*,refsym := sym5 
wp*,refseg ;= spj 
wp-.defsym := nil; 
wp-.defseg := nil; 
wp-.next := uother; 
uother := wp5 

GOTO 1 
END; 
PL := PL". NEXT 
UNTIL PL = LPL; 
2: 

1 := 1-1 

UNTIL I < 0; 
RP := RP^.NEXT 
END C WHILE J 
END 
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END; 



1: 



END C CHECKREFS J 5 
BEGIN C KEFSKCH D 

IPL := nil; 
lpl := procs: 

rtHILE LPL <> NIL DO 

IF (LPL~.DEFSEG = SP) 
AND LPL^.NLEDSRCH THEN 
BEGIN 

IPL := LPL? 
LPL := NIL 
END 
ELSE 

LPL := LPL". next; 
IF IPL <> NIL THEN 
BEGIN 

LPL := IPL; 
REPEAT 

DIFFSEG := LPL^.DEFSEG <> IPL^.DEFSEG; 
IF NOT DIFFSEG THEN 
LPL := LPL~.NEXT 
UNTIL DIFFSEG OR (LPL = NIL)? 
CHECKREFStSP^.SYMTAB) ; 
REPEAT 

IPL^.NEEDSRCH := FALSE? 
IPL ;= IPL". NEXT 
UNTIL IPL = LPL 
END 
END C REFSRCH 3 ! 



* 
* 
* 
* 
D 



FINDLOCALS RECURSIVLY SEARCHES THE MAIN SEGS SYMTAB TO 
PLACE ANY UNRESOLVED THINGS LIKE PUBLIC REFS IN UNIT 
SEGS INTO THE ULOCAL LIST SO THEY CAN BE FIXED UP IN 
FIXUPREFS IN ADDITION TO THE SEP PROC THINGS. 



PROCEDURE findlocalscsym: SYMP)! 

var wp: workp; 



1801 

1802 

1803 

1304 

1805 

1306 

1307 

1308 

1809 

1810 

1811 

1812 

1813 

1314 

1815 

1816 

1817 

1818 

1819 

1820 

1821 

1822 

1823 

1824 

1825 

1826 

1827 

1828 

1829 

1830 

1831 

1832 

1833 

1834 

1835 

1836 

1837 

1838 

1839 

1840 

1841 



1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 
1 
1 
1 



4o:o 
40:1 
40 : ?. 
4 o : 3 
40:3 
4u:3 



3 
4 
5 
5 
5 
5 
5 
5 
5 
4 
2 



40 
40 
40 
40 
40 
40 
40 
40 
40 
40 
40 

<+o:o 
4o:o 
29:0 

2911 

29 :i 
29:1 
29:1 
29:1 
29:1 

2911 

29:2 
29:3 

29:4 

29:4 
29:5 

29.'6 
29:6 
29:6 

29:5 

29:4 

29:5 

29:4 

29:5 

29:6 





5 
s 

9 
13 
17 
24 
24 
29 
34 
39 
44 
49 
54 
54 
58 
58 
70 


4 
8 
12 
16 
20 

24 

37 

43 

43 

50 

55 

55 

60 

73 

81 

88 

90 

05 

12 

12 



3 ELGIN 

IF SYM <> NIL THEN 
BEGIN 

FIMOLOCALSCSYW.LLINK) \ 
FIMDLOCALSISYM^.RLINK) ; 
FINDL3cALS(5YM A . SLINK) ; 
IF SYM*. ENTRY. LITYPE IN 
BEGIN 

NEW(WP) ! 

WP".KEFSYiV) := SYM; 
WP^.REFSEG ;= NIL; 
mlP^.OEFSYM := NIL; 
WP~.DEFSEG := NIL; 
imp*. NEXT := ULOCAL! 

ulocal := WP 

END 
END 
END C FINDLOCALS 3 ; 



begin c buildworklists 1 

procs := nil; 

local := nil; 

other := nil; 

UPROCS := NIL; 
ULOCAL := NIL; 
UOTHER := NIL; 
WITH SEGINFOCS:r DO 

IF SEGKIND <> LINKED THEN 
3EGIN 

SEPHOST := SEGKIND = SEPRTSEG; 
IF SEPHOST THEN 
BEGIN 



CUNITREF, PUBLREF, PRIVREF] THEN 



NEXT := 
SEPLIST 
UPROCS 
END 
ELSE 

UPROCS := 
WHILE UPROCS 
BEGIN 

RESOLVE(UPROCS, 



SEPLIST5 

:= seginfocsu; 

:= FINDPROCSICSEPPROC, 



SEPFUNCDt SYMTAB) 



FlNDPROCS(CEXTPROC» 
<> NIL DO 



PROCS) 



EXTFUNC3, SYMTAB) 
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SP := SEPLIST; 
WHILE SP <> NIL DO 
BEGIN 

ref-srch(cgl03ref» seppref, sepfrefdt sp)5 
sp := sp^.next 

end; 
resolvmuother, other); 
findnewprocs 
end; 

IF NOT SEPHOST THEN 
BEGIN 

FINDLOCALS(SYMTAB); 

resolve(ulocal» local) 
end; 
wp := procs; 
while wp <> nil do 

BEGIN 

WP^.NEEDSRCH := TRUE; 
WP := WP^.NEXT 

end; 
sp := seplist; 

WHILE SP <> NIL DO 
BEGIN 

REFSRCH(CPUBLREF, PRIVREF, CONSTREF3, SP)J 
SP := SP-.NEXT 

END! 
RESOLVE(UOTHER» OTHER) 
END 
END C BUILDWORKLISTS 2 ; 

LINK3A 2 
LINK3B 2 

J******************************************************************) 
(* *) 

(* COPYRIGHT (C) 1978 REGENTS OF THE UNIVERSITY OF CALIFORNIA. *) 
<* PERMISSION TO COPY OR DISTRIBUTE THIS SOFTWARE OR DOCUMEN- *) 
(* TATION IN HARD OR SOFT COPY GRANTED ONLY BY WRITTEN LICENSE ♦) 
(* OBTAINED FROM THE INSTITUTE FOR INFORMATION SYSTEMS. *) 

<* *) 

(it*****************************************************************) 
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readsrcseg determines the final segment size after adding 
ij the external procs/funcs, allocates enough area for the 
entire output code seg, reads in the original code (or uses 
identity segment for sephost special case), and splits the 
segdict off from the code, for all procs to-be-linked, a new 
destbase position is assigned in seg and the new proc num is 
set up in pdict. the segment number field of the pdict is 
also updated to the value of s. all is ready to copy in the 
sep procs/funcs. the values for segbase and segleng are set 
here too. 



procedure readsrcseg; 
var orgleng, addr, 
addleng, addprocs, 
nextspot: integer; 
last: o..maxproc; 
wp: workp; 
lheap: ^integer; 



* 

* 
* 

* 
* 



readnsplit arranges for the source seg to be placed in 
room allocated for segbase. this may involve disk read 
or perhaps only creating an empty segment. in any case 
segbase points at lowest addr, and nextspot is pointed 
at the next place code can be copied into. this is used 
for destbase assignment in readsrcseg, 



procedure readnsplit; 
var nblocks, n, pdleng, 

pddelta, nprocs: integer; 
cpo, cpi: codep; 

BEGIN 

NBLOCKS := (SEGLENG+511) DIV 512! 
IF MEMAVAlL-*+00 < NBL0CKS*256 THEN 
BEGIN 

ERROR( »NO MEM ROOM* ) ; 
EXIT(LINKER) 
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SEG 3 

SEGLENG-2) ; 



end; 
n := nblocks; 

REPEAT 

C ALLOC HEAP SPACE 3 
NEto(CPl) i 
N := N-l 
UNTIL N <= 0; 
IF SEPHOST THEN 

BEGIN C SET UP IDENTITY 
STOREWORU(0, SEG3ASE, 
NEXTSPOT := 
END 
ELSE 

BEGIN I READ FROM DISK 3 

NBLOCKS := (ORGLENG+511) DIV 512? 

IF BLOCKREADtSEGlNFOCSiT.SRCFILE^.CODE*, SEGBASE", 
NBLOCKS, ADDR) <> NBLOCKS THEN 
BEGIN 

ERROR( »SE6 READ ERR') ; 
EXIT(LINKER) 
END; 
PDDELTA := SEGLENG-ORGLENG; 
NPROCS := FETCHBYTE(SEGBASE, ORGLENG-1); 
PDLENG := NPROCS*2+2! 
NEXTSPOT := ORGLENG-PDLENG; 

CPO := GETCODEP(ORO(SEGBASE)+ORGLENG-PDLENG) ; 
CP1 := GETCODEP(ORD(SEGBASE)+SEGLENG-PDLENG) 5 
IF CPO <> CP1 THEN 

3EGIN t MOVE PROC DICT 3 
N := PDLENG; 
WHILE N > 2 DO 
BEGIN 

STOREWORD(PDDELTA+FETCHWORD(SEGBASE, ORGLENG-N) , 

SEG8ASE, ORGLENG-N); 
N := N-2 

end; 

MOVEKIGHTtCPO*, CP1*» PDLENG); 
FILLCHAR(CP0^» PDDELTA, 0) 
END 
END 
END C READNSPLIT 3 \ 
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, SRCFILE^.SEGTBL.DISKINFOCSRCSEGD DO 



;= CODELENG; 
COUEADDR 



BEGIN C READSRCSEG ■ 
IF SEPHOST THEN 

ORGLENG := 2 
ELSE 

WITH SEGINFOCSU' 
BEGIN 

ORGLENG 
ADDR := 
END? 

addleng := o; 
addpRocs := 0; 
wp := procs; 
while wp <> nil do 
begin c add up final seg size 1 

ADDLENG := AUDLENG+WP*. DEFSYM*. ENTRY. PLACE*. LENGTH ; 
IF WP^.NEWPROC = THEN 

ADDPROCS 1= ADDPROCS+1S 
WP := WP^.NEXT 
END} 
MARK(LHEAP) ; 

SEG3ASE := GETCODEP(ORD(LHEAP) ) ; 
SEGLENG := 0RGl_ENG+ADDLENG + 2*ADDPR0CS; 
IF SEGLENG <= THEN 
BEGIN 

ERR0R(»SIZE OFLOW') ; 
EXIT(LINKER) 
END; 

readnsplit; 

last := fetchbyt£(segbaset segleng-1); 
wp := procs; 
while wp <> nil do 
begin i assign places in code seg 1 
with wp^.defsym". entry. place" do 

BEGIN 

destbase := nextspot; 

nextspot := nextspot+length 
end; 
if wp^.newproc = then 
begin c assign new proc u 2 

LAST := last+i; 
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IF LAST > MAXPROC THEN 
BEGIN 

ERKOK('pHOC M'JM OFLOIn 1 ); 
LAST := 1 

END; 

wp".newproc := last 
end; 

wp := WP^.NEXT 
end; 
stqrebyte(last, segbase, segleng-1); 
storebyte(si segbasei segleng-2) 

END c READSRCSEG 1 J 



coprinprocs goes through procs list and copies procedure 
bodies from the sep segs into the dest code segment into 
locations set up in readsrcseg. if all goes right» we should 
fill dest seg to the exact byte. the proc dict is 
updated to show procedures' position. 



PROCEDURE COPYINPROCS; 
VAR CPO. CP1» PDP. 

JTAB. sepbase: codep; 
wp: workp; 
cursp: segp; 
lheap: ^integer; 

c 

* READSEPSEG READS THE SEP SEG IN SP ONTO THE HEAP AS 

* DONE IN PHASE 2. WE SET UP SEPBASE AND CURSP FOR 

* COPYINPROCS. 
D 

PROCEDURE READSEPSEGtSP! SEGP); 

VAR Nt NBLOCKS: INTEGER; 
BEGIN 

RELEASE(LHEAP) ; 

N := SP~.SRCFILE~.SEGT8L.DISKI{\iF0CSP*.SRCSEG:i.C0DELENG; 

NBLOCKS := (N+511) DIV 512; 

IF WIEMAVAIL-400 < NBL0CKS*256 THEN 
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3ZGIU 

ER^0R( 'OUT OF M^M' ) ; 
EXIT(LINKER) 

end; 
iM := nblocks; 

REPEAT 

NEW(SEPBASt) J 

n := w-i 

UNTIL N <= 0; 

SEPBASE := GETCODEP(ORD(LHEAP>); 

IF BLOCKREAD(SP~.SRCFlLE*. CODE'S SEPBASE** NBLOCKS, 

SP-.SRCFILE-.SEGTBL.OISKINFOCSP-.SRCSEGD.CODEADDR) <> NBLOCKS THE 

BEGI N 

ERROR(»SLP SEG READ ERR'); 
EXIT(LINKER) 

end; 
cursp := sp 
end c readsepseg d 5 

begin c copyinprocs ] 
sepbase .*= nil; 
cursp := nil; 
mark(lheap) ; 
wp := procs; 
while wp <> nil do 

WITH WP A » DEFSYM-. ENTRY DO 
BEGIN Z COPY IN EACH PROC 1 
IF CURSP <> DEFSEG THEN 

READSEPSEG(DEFSEG) ; 
IF TALKATIVE THEN 
BEGIN 

WRITEC COPYING •); 

IF LITYPE = SEPPROC THEN 

WRITE(«PR0C •) 
ELSE 

WRITE(»FUNC •); 
WRITELN(NAME) 
END! 

CPO := GETCODEP<ORD(SEPBASE)+PLACE*.SRCBASE); 
CP1 := GETC0DEP(0RD(SEG3ASE)+PLACE~.DESTBASE>; 
MOVELEFT(CP0% CPl~, PLACE - *. LENGTH) 5 
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43; 



43:i 
43:0 
43:0 
43:0 
43:0 
43:0 
43:0 
43:0 
43:0 
43 :o 

4310 

<+5:d 

'♦SID 
45 :d 
45:d 
<+5:d 
45:0 
45:1 

45.* 2 

45:3 
45:3 
45:4 
45:4 

45:4 
45:4 
45:4 
45:4 

45:5 

45:4 

45:4 

45:6 

45:7 

45:6 

45:7 



49 
63 
78 
84 
04 
11 
11 
17 
19 
38 
38 
38 
38 
38 
38 
38 
38 
38 
1 
3 
7 
9 
10 


5 
14 
14 
14 
18 
18 
25 
31 
39 
43 
54 
b4 
54 
60 
60 
66 



JTAB := &ETC0DEP(0RQ<SEG3ASE)+PLACE'\DESTBASE + PLACE' % .LENGTH-2} 
IF FETCHBYTEUTAB, 0) <> THEN 

ST0RE3YTE(NEWPK0C, JTABi 0); 
PDP := GETC0DEP(0RD(SEGBASE)+SEGLENG-2*NEWPR0C-2) ; 
STOREWORD(ORD(PDP)-ORD(JTAB) , PDP» 0); 
WP ."= NEXT 

eno; 

RELEASE(LHEAP) 
END [ COPYINPROCS ^ ; 



5^n 



* 

* 
* 



fixuprefs is called to search through refllsts and fix 
operand fields of p-code and native code to refer to the 
resolved values. if fixallrefs is truei then all pointers 
in the ref lists are usedt otherwise the reference pointers 
are checked to see if they occur in the procs to-be-linked. 



PROCEDURE FIXUPREFS(WORK: workp; 
VAR Nt It REF, VAL: INTEGER; 

wp, wpi: workp; 
rp: refp; 
skipit: boolean? 

BEGIN 

WHILE WORK <> NIL DO 

WITH WORK A t REFSYW*. ENTRY DO 
BEGIN C FOR EACH WORK ITEM 
C FIGURE RESOLVE VAL 
CASE LITYPE OF 
SEPPREFt 

sepfref: val : 

unitref: val : 

constref: val ; 

globref: val : 



fixallrefs: boolean); 



DEFPROC^.NEWPROC; 

DEFSEGNUM; 

DEFSYM^. ENTRY. CONSTVAL; 

DEFS YM*. ENTRY. ICOFFSET+ 

DEFPROC~.DEFSYNP. ENTRY. PLACE*, DESTBASE? 



PUBLREF* 

privref: 



begin 
if litype = privref then 
val := newoffset 

ELSE 

VAL := DEFSYM A . ENTRY, BASEOFFSET; 
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END 

end; 

n := nrefs; 

RP := REflist; 

WHILE RP <> NIL 
BEGIN 

IF M > 8 

BEGIN 

1 : = 
n : = 

end 
else 
1 

REPEAT 
REF 



IF FORMAT = WORD THEN 

VAL := (VAL-1)*2+MSDELTA 

ELSE C ASSUME BIG D 
IF VAL < THEN 

ERROR( »ADDR OFLOW ) 



DO 



THEN 

7? 

N-8 



;= N-i; 



DO 

= REFSEG 

MATCHING 



THEN 
SEG 3 



= RP^.REFSCIJ; 
SKIPIT ;= NOT FIXALLREFS; 
IF SKIPIT THEN 

BEGIN C SEE IF PERTINENT 
WP := NIL! 

wpi := procs; 

WHILE WPI <> NIL 

IF WPl^.DEFSEG 

BEGIN C FIND 

wp := wpn 

wpi := nil 

END 
ELSE 

wpi := wpi*. next; 

WHILE (WP <> NIL) AND SKIPIT DO 

IF WP-.DEFSEG = REFSEG THEN 
WITH WP*.DEFSYM A . ENTRY. PLACE* 
IF REF >= SRCBASE THEN 

IF REF < SRCBASE+LENGTH THEN 

BEGIN 

REF := REF-SRCBASE+DESTBASE; 
SKIPIT := FALSE 



DO 
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END 
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ELSE 
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WP := WP^.NEXT 
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ELSE 
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WP := NIL 
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ELSE 
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WP 


:= nil 
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end; 
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IF NOT SKIPIT THEN 
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CASE FORMAT OF C FIX UP THIS REF 1 


2179 
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06 




word: 


STOREWORD(VAL+FETCHWORD(SEGBASE, REF) ♦ 
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SEGBASE, REF); 


2181 


1 


45:8 


24 




byte: 


STOREBYTECVALt SEGBASE, REF); 
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big: 


STOREBIG(VAL, SEGBASE, REF) 
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end; 
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1 := 1-1 
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until i < 0; 
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RP := RP^.NEXT 
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end; 
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WORK := NEXT 
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END 
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END C FIXUPREFS 3 i 
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* 


WRITETOCODE TAKES THE 


FINALIZED DESTSEG AND PUTS IT IN 
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* 


THE OUTPUT CODE FILE, 


THIS ALSO INVOLVES SETTING UP VALUES 
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* 


IN THE FINAL SEGTABLE 


FOR WRITEOUT JUST BEFORE LOCKING IT. 
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PROCEDURE WRITETOCODE; 
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VAR NBLOCKS: INTEGER; 
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jtab: codep; 




2201 


1 


46!0 





BEGIN 
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IF HOSTSP = SEGINF0CS3 


THEN 
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BEGIN C FIX UP BASELC 1 
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JTAB := GETC0DEP(0RD(SEGBASE)+SEGLENG-4) ; 
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JTAB := GETCODEP(ORD(JTAB)-FETCHWORD(JTAB» 0)); 
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STOREW0RD(NEXTBASELC*2-6» JTAB, -8) 
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end; 
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WITH SEGINFOCSir* SEGTBL DO 
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END 



NBLOCKS := (SEGLENG+bll) DIV 512? 

IF BLOCKWUITECCODE, SEGBASE*, NBLOCKS, NEXTBLK) <> NBLOCKS THEN 
bEGI'J 

ERROR( 'CODE WRITE ERR') ; 
EXIT(LINKER) 

end; 

DI5KINF0CSD.C0DEADDR : = NEXTBLK; 
DI3KINF0CSD.C0DELENG := SEGLENG; 
SEGNAMECS3 := SRCFILE* .SEGT3L . SEGNAMEC SRCSEG3 ; 

segkindcs: := linked; 
nextblk := nextblk+nblocks 
eno 

c writetocooe ^ ; 



* 

* 
* 
* 
* 
* 
* 



LINKSEGMENT IS CALLED FOR EACH SEGMENT TO BE PLACED INTO 
THE FINAL CODE FILE. THE GLOBAL VAR S HAS THE SEGINFO INDEX 
PERTAINING TO THE SEGMENT, AND ALL THE OTHER PROCEDURES OF 

THE* Sa1tER E SE? L S^ ar F J? M y ^ RE: - THIS PR0C FAClL?TA?ES R [lNKING 
THE MASTER SEG SEPARATLY FROM THE OTHER SEGS TO ENSURE THAT 
THE DATASZ OF THE OUTER 3L0CK CORRECTLY REFLECTS THE NUMRFR 
OF PRIVREF WORDS ALLOCATED BY RESOLVE. REFLECTS THE NUMBER 



PROCEDURE LINKSEGMENT; 



* WRITEMAP IS CALLED FOR EACH SEG TO WRITE SOME 

* INFO INTO MAP FILE. 

PROCEDURE WRITEMAP; 

var wp: workp; 

B: BOOLEAN; 
8EGIN 

WITH SEGINFOCS3- DO 

Wp W := T pROCsf' ' SEG * ,,S,,t '' S RCFILE-.SEGTBL.SEGNAMECSRCSEG3); 
IF WP <> NIL THEN 

WRITELN(MAP, » SEP PROCSM; 
WHILE WP <> NIL DO 
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""TO i 
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WITH WP~.DtFSYM~. ENTRY DO 

BEGIN 

rtRITE(MAP» ' •. NAME) 
IF LITYPE = SEPPROC THEN 

WRITL(MAP« * PROCM 
ELSE 

WRITE(MAP. 
WRITE(MAP, • 
ldRITE(MAP, • 
WRITEtMAP, • 
WRITELN(MAP) ! 



U 



FUNC» ) ; 

», WP^.NEWPROC: 3) 



BASE 
LENS 



— i 

— t 



PLACE*. DESTBASEJ 6); 

place". length: 5) ; 



WP 

end; 

FOR B 
BEGIN 
IF B 



:= WP-.NEXT 



= FALSE TO TRUE DO 



THEN 
BEGIN 

wp := other; 

IF WP <> NIL THEN 
WRITELN(MAPt • 
END 
ELSE 
BEGIN 

WP := LOCAL; 
IF WP <> NIL THEN 
WRITELN(MAP» • 
END; 
WHILE WP <> NIL DO 

WITH WP^.DEFSYM". ENTRY 
BEGIN 

WRITE(MAP, • 

CASE LITYPE OF 

SEPPROC, 

SEPFUNC: 

PUBLDEF: 

constdef: 

PRIVREF: 
UNITREF: 
GLOBDEF: 



SEP PROC REFS* ) 



LOCAL SEG REFSM 



DO 



NAME) 



WRITE(MAP» » PUBLIC LC ='» 
WRITE(MAP» • CONST VAL =», 
WRITE<MAPt ' PRIVAT LC =»» 
WRITECMAPt * UNIT SEG« =»♦ 
WRITE(MAP« • GLOB DEF IN f t 

WP^.DEFPROC^.DEFSYM". ENTRY. NAME, 

• a*, icoffset: 5) 



baseoffset: 5); 
constval: 6); 
wp^.newoffset: 5) 
wp*.defsegnum: 3) 



2292 1 48:6 50 ENL >; 

2293 1 48!6 B4 wRITELN(MAP) 

2294 1 48: b 91 



iwP := WP*,NEXT 



2295 i 48:5 92 e>j c . 

2296 i 48:2 9b Ef g D; 

2297 i 48:i 04 WRI TELN < MAP ) 

2298 1 48: 11 rND c WRITEMAP 3 J 

2299 1 48:0 40 

2300 1 47.-0 BEGIN C LINKSEGUENT 3 

2301 1 47.*1 SEPHOST := FALSE! 

2302 1 47!1 4 SEG3ASE := NIL; 

23 03 1 47:i 8 seslens := o; 

2304 1 47:i 12 IF TALKATIVE THEN 

2305 1 47:2 15 WI TH SEGINF0CS3* DO 

2306 1 47:3 28 WRITELN( •LINKING • 1 



2307 1 47:3 46 



2308 1 47:i 94 3UILDW0RKLISTS; 

2309 1 47:i 96 IF ERRCOUNT = THEN 

2310 1 47:2 01 3 E GIN 

2311 1 47:3 01 READSRCSEG; 

2312 1 47:3 03 IF MAPNAME <> •» THEN 

2313 1 47:4 12 WRITEMAP; 

2314 1 47:3 14 COPYINPROCS; 

2315 1 47:3 16 FIXUPREFS(LOCAL, TRUE)? 

2316 1 47:3 22 FlXUPREFS(OTHERt FALSE); 

2317 1 47.-3 28 WRITETOCODE 

2318 1 47:2 28 EN D5 

2319 1 47U 30 IF SEPHOST THEN 

2320 1 47:2 35 SEPLIST .'= SEGINFOC SH-.NEXT ; 

2321 1 47:i 49 RELEASE(HEAPBASE) 

2322 1 47:0 51 END C LINKSEGMENT J 5 

2323 1 47:o 66 

2324 1 28:0 BEGIN C PHASE3 1 

2325 1 28:i IF NOT USEWORKFILE THEN 

2326 1 28:2 17 BEGIN 

2327 1 28:3 17 WRITE( •OUTPUT FILE? •); 

2328 1 28:3 40 READLN(FNAME ) 5 

2329 1 28:3 55 USEWORKFILE := FNAME = »' 

2330 1 28:? 57 END? 

2331 1 28:i 64 IF USEWORKFILE THEN 

2332 1 28:2 67 REWRITE(C0DE, • *SYSTEM.WRK.CODEC*3 t ) 



SRCFILE^.SEGTBL.SEGNAMECSRCSEGD* • U •, S) 
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;^r 
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28:5 
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28 
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28 
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47 
47 
67 
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15 
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31 
31 
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69 
74 
76 
76 
99 
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57 
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67 
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06 
20 



ELSE 

REWRITE(CODEi Fr-JAML) ; 
IF IOR^SULT <> THEN 
BESIM 

ERROR ('CODE OPEN ERR»)? 
EXit(LINKER) 

end; 
nextblk := i; 

C CLEAR OUTPUT SEG TABLE 3 
FILLCHAR(SEGTBL* SIZEOF ( SEGTBL ) t 0); 
WITH SEGTBL DO 

FOR S := TO MAXSEG DO 
BEGIN 

segnamecs: :r * •; 

SEGKINDCS3 := LINKED 
END; 
IF MAPNAME <> •• THEN 
BEGIN 

REWRlTE(MAPt MAPNAME); 
IF IORESULT <> THEN 
BEGIN 

WRITELN( , CAN ,, T OPEN S MAPNAME); 
MAPNAME := • f 
END 
ELSE 
BEGIN 

WRITE(MAP, 'LINK MAP FOR *)» 
IF HOSTSP <> NIL THEN 

WRITELN(MAPf HOSTSP^. SRCFILE*. SEGTBL. SEGNAMECHOSTSP*. SRCSEG 3 ) 
ELSE 

WRITELN(MAP» * ASSEM HOST* ) ; 
WRITELN(MAP) 
END 

end; 
markiheapbase) ; 

UNITWRITE(3i HEAPBASE~, 35); 
C LINK ALL BUT HOST 3 
FOR S := TO MAXSEG DO 

IF (SEGINFOCS3 <> NIL) 

AND (SEGINFOCS3 <> HOSTSP) THEN 
LINKSEGMENT; 
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I 
<> 



RESTORE 
1 THEN 



C LINK HOST LAST! 3 
IF HOSTSP <> NIL THLN 
=JEGIN 

s := ma3tcrseg; 
linksegment 
end; 
if flipped then fliptable ( segt3l ) ? 

IF BLOCK*miTE<COOE t SEGTBLi 1, 0) 

ERROR('CODE WRITE ERR») ; 
IF ERRCOUNT = THEN 

BEGIN C FINAL CLEANUP 1 
CLOSE(CODE» LOCK); 
IF IJSEWORKFILE THEN 
WITH USERINFO DO 
BEGIN 

GOTCODE 
CODEVID 
CODETID 

end; 
if mapname <> »• 

BEGIN 

IF HOSTSP <> 

WRITELN(MAP. 'NEXT 3ASE LC = • i NEXTBASELC); 
CLOSE(MAP, LOCK) 

END 
END 

END C PHASE3 2 ; 

C$1 LINK3B 1 

BEGIN C LINKER 1 

PHASE1; 

PHASE2; 

PHASE3; 

UNITCLEAR(3) 
END C LINKER 1 ; 

BEGIN END. 



BYTE-FLIPPED STATE 3 



TRUE! 

syvid; 

•system. wrk.code» 

THEN 
NIL THEN 



327 



'TOO 

Jo" 



as of the printing of this book, 
the .Assembler was not listed, 

The Assembler may be available 
at a later date in a suppliment 
at additional cost, 

Thank you for your patience, ed. 
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(*************** ***********************************************■:„***) 

PROGRAM PASCALSYSTEM; 
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************************************************) 

CONST 



MMAXINT = 32767; 
MAXJMIT = 12; 
MAXDIR = 77; 
VIDLENG = 7; 



(*MAXIMJM INTEGER VALUE*) 
(♦MAXIMUM PHYSICAL UNIT U FOR UREAD*) 
(*MAX NUMBER OF ENTRIES IN A DIRECTORY*) 
(♦NUMBER OF CHARS IN A VOLUME ID*) 
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TYPE 



T I 3 _ ~ N 3 = 15; 
■•"AXSEG - 15; 
FBLKSlZt. = 512; 
DIR5L« = 2; 
AGELI^IT = 300; 
EOL = 13; 
OLE = 16? 
NAME-LEN = 23 5 
FILL.LEN = 11 ! 



(*NUM_sER OF CHARS IN TITLE ID*) 

(♦MAX CODE SEGMENT NUMBER*) 

(♦STANDARD DISK 3L0CK LENGTH*) 

(♦DISK ADDR OF DIRECTORY*) 

(♦MAX ASE FOR GDIRP...IN TICKS*) 

(♦END-OF-LINE.. .ASCII CR*) 

(♦BLANK COMPRESSION CODE*) 

CLENGTH OF CONCAT ( VIDLENGt • : » , TIDLENG ) 3 

[MAXIMUM n OF NULLS IN FILLER3 



IORSLTWD = (INOERROR,IBADBLOCK»IBADUNlT,IBADMODE»lTIMEOUT, 
ILOSTUNITtlLOSTFILE.IBADTITLEtlNOROOMiINOUNIT, 
INOFlLEtlDUPFlLEf INOTCLOSEDtlNOTOPEN.lBADFORMAT* 
ISTRGOVFD ! 

(♦COMMAND STATES. ..SEE GETCMD*) 

CMDSTATE = < HALTINIT.DEBUGCALL* 

UPROGNOU,UPROGUOK»SYSPROG» 
COMPONLY,COMPANDGOtCOMPDEBUG« 
LINKANDG0»LINKDEBUG) ; 

(*CODE FILES USED IN GETCMD*) 

SYSFILE = (ASSMBLER,COMPlLERiEDITOR,FILER»LlNKER) ! 

(♦ARCHIVAL INFO. ..THE DATE*) 



DATEREC = PACKED RECORD 

MONTH: 0..12; 

day: 0..31; 
year: 0..100 
end (♦daterec*) 



UNITNUM = 0..MAXUNIT; 
MID = STRINGCVIOLENG3! 



(*0 IMPLIES DATE NOT MEANINGFUL*) 

(♦DAY OF MONTH*) 

(♦100 IS TEMP DISK FLAG*) 



(♦VOLUME TABLES^) 



(♦DISK DIRECTORIES*) 
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DIR^ANGE = 0..-1AXDIR; 
TIJ _ STRINGCTI^LLNGJ; 
FJLl.ID - STRlUGCNAME-LEfJj; 

FILc.TA.-jLE = ARRAY CSYSFILE3 OF FUl_L_ID; 



FILEKlND = 



(UNTYPt-DFILE.XDSKFILEtCODEFILEfTEXTFlLE, 
irJF0FlLC,DATAFlLE»GRAFFlLE,F0T0FlLE,SECUREDIR) 



DlRENTRy = 



packed record 
dfirstblk: in 
dlastblk: INT 

CASE DFKIND: 
SLCUREDIR, 
UNTYPEDFILE 
(FILLER1 

dvid: v 

DEOVBLK 

DNUMFIL 

DLOADTI 

DLASTBO 

XDSKFILEiCO 

DATAFILEtGR 

(FILLER2 

STATUS 

dtid: T 

DLASTBY 

DACCESS 

END (*DIRENTRY* 



teger; (*first 
eger; (*point 
filekino of 

: (*only in dirc 

: 0..2048; CFOR 

id; 

: INTEGER; 

es: dirrange; 
me: integer; 
ot: daterec); 

DEFILE, TEXTFILE, 
AFFILE, FOTOFILE: 
: 0..1024; CFOR 
: BOOLEAN; 

id; 

te: l.fblksize; 

: DATEREC) 

) ; 



PHYSICAL DISK ADDR*) 
S AT BLOCK FOLLOWING*) 



OH.. .VOLUME INFO*) 

DOWNWARD COMPATIBILITY, 13 BITS3 

(*NAME OF DISK VOLUME*) 

(*LASTBLK OF VOLUME*) 

(*NUM FILES IN DIR*) 

(♦TIME OF LAST ACCESS*) 

(♦MOST RECENT DATE SETTING*) 
INFOFILE, 

DOWNWARD COMPATIBILITY^ 

CFOR FILER WILDCARDS^ 
(*TITLE OF FILE*) 
(*NUM BYTES IN LAST BLOCK*) 
(*LAST MODIFICATION DATE*) 



DIRP = "DIRECTORY! 

DIRECTORY = ARRAY CDIRRANGEJ OF DIRENTRY; 

(♦FILE INFORMATION*) 

CLOSETYPE = (CNORMAL, CLOCK, CPURGE , CCRUNCH ) ; 
WINDOWP = "WINDOWS 

WINDOW = PACKED ARRAY C . . 1 OF CHAR; 
FIBP = "FIB! 
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RECORJ 

Ft-.r-jj 

FlOF, 
FSTAT 
FRLCS 
CASE 
TRU 



F£0L 

E: ( 
ize: 

FISO 

E: ( 



W1NDOWP 

w: ijooL 

FJANDw* 
INTEGE 

hen: BO 

FISBLKD 

funit: 
fvid: v 

FREPTCN 
FNXTBLK 
FMAXBLK 
FMODIFI 
F HEADER 
CASE FS 

true: 



TCHAR) ; 

...C=>BLOCKFlLEt 1=>CHARFILE* ) 



; (*USER WI-JDOW. ..F~* USED BY GET-PUT*) 

EAN; 

FNEEDCHARtFGO 

r; <*in bytes 

OLEAfJ CF 

: boolean; 

unitnum; 

id; 



(* 
(* 
(* 
(* 
(* 
(* 
(* 



: integer; 
ed:boolean 
: oirentrym* 
0ft8uf: boole 

(FNXTBYTEiFM 

fbufchngd: 
fbuffer: pa 



file is om block device*) 
physical unit »*) 
volume name*) 

u times f~ valid w/o get*) 
next rel block to 10*) 
max rel block accessed*) 
please set new date in close*) 
copy of disk dir entry*) 
an of (*disk get-put stuff*) 
axbyte: integer; 
boolean; 
cked array c 0. .fblksized of char)) 



END (*FIB*) J 



<*USER WORKFILE STUFF*) 



infqrec = record 

symfibp.codefibp: fibp; 
errsym,errblk«errnum: integer; 
slowterm, stupid: boolean? 
altmode: char; 
gotsym,gotcode: boolean? 
workvid»symvid,codevid: vid; 
worktid,symtid,codetid: tid 
end uinforec*) 5 



(*W0RKFILES FOR SCRATCH*) 
(♦ERROR STUFF IN EDIT*) 
(♦STUDENT PROGRAMMER ID!!*) 
(♦WASHOUT CHAR FOR COMPILER*) 
(♦TITLES ARE MEANINGFUL*) 
(♦PERM&CUR WORKFILE VOLUMES*) 
(♦PERMSCUR WORKFILES TITLE*) 



SEGraNGE = 0..MAXSEG; 

segdesc = record 

diskaddr: 



integer; 



CODELENG: INTEGER 
END (*SEGDESC*) ; 



(*CODE SEGMENT LAYOUTS*) 



(*REL BLK IN C0DE...A3S IN SYSCOM**) 
(*# BYTES TO READ IN*) 



(^DEBUGGER STUFF*) 
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GYT^AN^E = 0..253; 

TRlCKARRAY - RZCOKD CMEMORY DIDDLING FOR EXECERR0R3 
CASE BOOLEAN OF 

TRUE : (WORD : ARRAY C . . 1 OF INTEGER)? 

FALSE : (BYTE : PACKED ARRAY L . . J OF 3YTERAN&E) 



(♦MARK STACK RECORD POINTER*) 



END 
MSCrtP = A MSCW; 
MSCmi = RECORD 

STATLIfvKI MSC/jP; (*POINTER TO PARENT MSCW*) 

dymlink: mscwp; (♦pointer to caller's mscw*) 
msseg,msjtab: a trickarray; 
msipc: integer; 
localdata: trickarray 

END (*MSCW*) ; 

(♦SYSTEM COMMUNICATION AREA*) 
(♦SEE INTERPRETERS... NOTE *) 
(♦THAT WE ASSUME BACKWARD 
(♦FIELD ALLOCATION IS DONE 



syscomrec = record 

iorslt: iorsltwd; 
xeqerr: integer; 
sysunit: unitnum; 
bugstate: integer; 
gdirp: dirp; 
lastmp.stkbase.bombp: 



♦ ) 
*) 



(♦RESULT OF LAST 10 CALL^) 
(♦REASON FOR EXECERROR CALL*) 
(♦PHYSICAL UNIT OF BOOTLOAD^) 
(♦DEBUGGER INFO*) 
(♦GLOBAL DIR POINTER»SEE VOLSEARCH*) 

mscwp; 



INTEGER! 

(♦WHERE XEQERR BLOWUP WAS^) 
(♦MORE DEBUGGER STUFFS) 
OF INTEGER; 

(♦DRIVERS PUT RETRY COUNTS^) 
.83 OF INTEGER; 



memtop,seg,jtab: 

BOMBIPc: INTEGER* 

hltline: integer; 
brkpts: array co. .33 
retries: integer; 
expansion: array co., 

HIGHTlMEtLOWTlHE: INTEGER; 
MISCINFO: PACKED RECORD 

NOBREAK. STUPID i SLOWTERM. 

HASXYCRT»HASLCCRT,HAS8510A,HASCL0CK: BOOLEAN; 
USERKIND: (NORMAL* AQUIZi BOOKER, PQUIZ); 
IS_FLIPT : BOOLEAN 
END; 
crttype: INTEGER; 
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DIGIT 



cutctrl: packed record 

rlftndfsteraseegl.eraseeosf home, esc ape: char 

backspace: char; 
fillcount: 0..255; 
clearscreen, clearline: char; 
prefixed: packed array co..8D of boolean 
end; 
crtinfo: packed record 

width, height: integer; 

right, left, down, up: char; 

badch,chardel, stop, break, flush, eof: char; 

altmode,linedel: char; 

backspace, etx, prefix: char; 

PREFIXED: PACKED ARRAY CO. .13:3 of boolean 
end; 
segtable: array csegranged of 
record 
codeunit: unitnum; 

COOEDESc: SEGDESC 

END 

(♦syscom*) ; 



END 



= record 
msyscom: 

end; 



syscomrec 



m: ^syscomrec; 

s: ARRAY CO. .53 OF FIBP? 

nfo: inforec; 
heap: ^integer; 
fib.0utputfi6' 

rm.swapfib: FIBP; 
,dkvid: VIO; 
te: daterec; 
info: ^integer; 
: cv.dstate; 

TRING; 

array co. .43 of integer 
r: stringcfill.lend; 
s: set of 'o'.. »9' ; 



(♦MAGIC PARAM...SET UP IN BOOT*) 
(♦GLOBAL FILES* 0=INPUT, l=OUTPUT*) 
(♦WORK STUFF FOR COMPILER ETC*) 
(♦HEAP MARK FOR MEM MANAGING*) 
(♦CONSOLE FILES. ..GFILES ARE COPIES*) 
(♦CONTROL AND SWAPSPACE FILES*) 
(♦SYSUNIT VOLID & DEFAULT VOLID^) 
(♦TODAY. ..SET IN FILER OR SIGN ON*) 
(♦DEBUGGERS GLOBAL INFO WHILE RUNIN*) 
(♦FOR GETCOMMAND^) 

(♦PROMPTLINE STRING. ..SEE PRO^PT^) 
(♦INTEGER POWERS OF TEN+) 
(♦NULLS FOR CARRIAGE DELAY+) 



246 u 113 1 

247 : i::.; i( 
245 :• i:„ i; 
Ht'i j i : . 

25C m l: ) 

251 J l: u 156 



2o4 (* SYSTl* PROCEDURE FORWARD DECLARATIONS *) " ~~~~~-~""~~ *> 

264 (* THESE ARE ADDRESSED BY OBJECT CODE... *) 



UMITaslE: ARKAY LUNITNUMU O c (*Q NOT USEn*) 
RECORD 

j Jv:d: vid; c *v/olu«ie id for unit*) 

kd ^ CASE UISBLKu: BOOLEAN OF 

l ^° true: (ueovblk: integer) 

J" 6 END (*UNITABLE*> ; 

"r ' J i,J 2 ' jtf FILENAME : FILE.TABLE; 
2^3 i:D 264 

254 l;j 264 (* 

255 I l:-j 

256 i:d 

ill ° * :D 254 <* 3o not move without careful thought" *j 

2 3 3 1 : D 2 6 <+ 

259 ° 2:d i procedure EXECERROR; 

26C 2ID I FORWARD; 

262 3^ i PR ™S E "NIT<VAR f: FIB! WINDOW: WINDOWP; RECWORDS: INTEGER); 

& J J • J 4 rURWARG; 

2 * 3 ° 4:D 1 PROCEDURE FRESET(VAR F: FIB); 

264 *:D 2 FORWARD; 

2 " J 5j0 1 PROCEDURE FOPENtVAR F : FIB; VAR FTITLEI STRING; 

267 0° t\o 5 FORWARD; F ° PEN ° LD: ^^ ^ FIBP>; 

HI I 6:D 1 PROCEDURE FCLOSEIVAR FI FIB; FTYPE: CLOSETYPE); 

«9 6:D 3 FORWARD; 

2J0 7ID 1 PROCEDURE FGET(VAR F; FIB); 

2? 1 7:D 2 FORWARD; 

272 8:D 1 PROCEDURE FPUT(VAR F; FIB); 

273 8:d 2 FORWARD; 

274 9:D l PROCEDURE XSEEK; 
2? 5 9:D 1 FORWARD; 

11% ° 10:D 3 FUNCTION FEOF(VAR F; FIB): BOOLEAN; 
277 lO'.D 4 FORWARD; 



278 ll:o 



2? 9 ll:o <f FORWARD; 



3 FUNCTION FEOLN(VAR F; FIB): BOOLEAN; 



280 C 12:D 

281 12:0 3 FORWARD; 

282 13:D 



1 PROCEDURE FREADINT(VAR F: FIB; VAR I: INTEGER); 



23, n ,,.. J PR ^ DU ! £ FWRITEINT(VAR F: FIB! I.RLENG: INTEGER); 

"° u lo.u 4 FORWARD; 

28I+ ° li+ ^ 1 PROCEDURE XRrADREAL; 

235 1<+:d i FORWARD; 

286 n 15; D 1 PROCEDURE XWRITEREAL; 
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1 forward 

1 PROCEDURE 

3 FO.«WARj 
1 PROCEDURE 

4 FORWARD 

i procedure: 

4 FORWARD 
1 PROCEDURE 

4 FORWARD 
1 PROCEDURE 

5 FORWARD 

1 PROCEDURE 

2 FORWARD 

1 PROCEDURE 

2 FORWARD 
1 PROCEDURE 

4 FORWARD 
1 PROCEDURE 

5 FORWARD 
1 PROCEDURE 
5 FORWARD 
1 PROCEDURE 
4 FORWARD 

3 FUNCTION S 



FRCADCHARU'AK F*. F"I3! VAR CM: CHAR); 

FWPITCCHARt VAR f: FI3; CH: CHAR; RLENG: INTEGER); 

FREADSTRINGCVAR F: FI3! VAR S: STRING; SLENG: INTEGER); 

FWRITESTRlNGtVAR FI FI3; VAR S; STRING; RLENG; INTEGER); 

FWRITE3YTZs(VAR F: FI3; VAR A: WINDOW; RLENG. ALENG! INTEGER); 

FREADLN(VAR F: FIB) i 

FWRITELNtVAR F: FIB) 5 

SCONCATIVAR DEST.SRC: STRING! DESTLENG: INTEGER); 

SINSERT(VAR SRC.OEST: STRING? DESTLENG, INSINX: INTEGER); 

SCOPYUAR SRC.DEST: STRING; SRCINX.COPYLENG: INTEGER); 

SDELETE(VAR DEST: STRING; DELlNX .DELLENG: INTEGER); 

POS(VAR TARGET. SRC: STRING): INTEGER? 



5 FORWARD, 
3 FUNCTION FBLOCKIO(VAR F: FIB! VAR A: WINDOW; I! INTEGER; 

6 N3L0CKS.RBL0CK: INTEGER; DOREAD: BOOLEAN): INTEGER; 

9 FORWARD; 

1 PROCEDURE FGOTQXY(X,Y: INTEGER); 

3 FORWARD; 

3 

3 (* NON FIXED FORWARD DECLARATIONS *) 

3 

3 FUNCTION VOLSEARCHtVAR FVlD: VID; LOOKHARD: BOOLEAN; 

5 VAR fdir: DIRP): UNITNUM; 

6 forward; 

1 PROCEDURE WRITEDIR(FuNIT: UNITNUM; FDIR: DIRP)! 

3 FORWARD; 

3 function dirsearch(var ftid: tid; findperm: booleanj fdir: dirpj: dirRange; 

6 FORWARD; 

3 function scantitlecftitle: string; var fvid: VID; var ftid: tid; 



5 2 a 


n 


33::j 


^ 


32 9 


:J 


53 : ) 


4 ;•< 


330 


~) 


34 :c 


i 


331 


;■} 


34:.; 


3 


552 


n 


^ D I t_ .■ 


1 


333 


1* 


^b: : 


4 


334 


w 


36 :d 


1 


335 


j 


36 :d 


1 


336 





37:;;. 


i 


337 


n 


37: D 


1 


333 


J 


38:d 


1 


339 


J 


38.- D 


1 

X 


340 





39 :o 


1 


341 





39: j 


1 


342 





4o:d 


3 


343 





40 :d 


4 


344 





4i:o 


3 


345 





4i:d 


4 


346 





<+2:d 


3 


347 





42:d 


4 


348 





<+3.*d 


1 


349 





43:d 


1 


350 





43:d 


1 


351 





f3:o 


1 


352 





<+3:d 


1 


353 





43:o 


1 


354 





<+3:d 


1 


355 





<+3:d 


1 


356 


1 


i:d 


1 


357 


1 


i:d 


1 


358 


1 


i:d 


1 


359 


1 


i:d 


1 


360 


1 


i:d 


1 


361 


1 


i:o 


1 


362 


1 


i:j 


1 


363 


1 


i:d 


1 


364 


1 


i:o 


1 


365 


1 


i:d 


1 


366 


1 


i:o 


1 


367 


1 


i:d 


1 


368 


1 


i:d 


1 



FlHwA , VAR FSL " Gs: integer; var fkind: filekind,: boolean? 

PROCEDURE CElFNTRY(F:NX: DIRR, A N5E; fdir: DIRP); 

FORWARD; 

PR F§RSAR3; IrJSE ' JTRY(VA " FENTRY: DIRENTRY; F ™*- DIRRANGE; FDIR: DIRP,; 

PROCEDURE HOMECL'RSOR; 

FORWARD; 
PROCEDURE CLEARSCREEN! 

FORwARD; 
PROCEDURE CLEARLINE; 

FORWARD; 
PROCEDURE PRO HPT? 

FORWARD; 

FUNCTION SPACEWAITCFLUSH: BOOLEAN): BOOLEAN; 
FORWARD; 

function getchar<flush: boolean,: char; 

FORWARD; 

function fetchdir(Funit:unitnumj : boolean; 

FORWARD; 
PROCEDURE COMMAND; 
FORWARD; 



<*SI GLOBALS.TEXT*) 
(* 



*) 



SEPARATE UNIT PASCALIOJ 
INTERFACE 

TYPE DECMAX = INTEGERC36D; 

STUNT = RECORD CASE INTEGER OF 
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INTEGERC4D, ; 
INTEGERC3:, ; 
INTEGERE123) ; 
INTEGERC16D) ; 
INTEGERC20H, ; 
INTEGERC243) ; 
INTEGERC263, ; 
INTEGERC323) ; 
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10: (»10:INTE.GLKC3S3) 



UVJi 



fseek(var f: fib; recnum: 
freadreal(vap f: fib; var 
fwritereal(var f: fib! x: 
freaddec(var f: fi3; var 
fwritedec(var f: fi3; d: 



PROCEDURE 

PROCEDURE 

PROCEDURE 

PROCEDURE 

PROCEDURE 

FUNCTION SUPER- "100(AiB 

FUNCTION SUPER-DIVlAiB 



INTEGER) 
INTEGER) 



INTEGER) 5 

x: read; 

real; Wt 0: integer); 
d: stunt; l: integer); 
decmax5 rleng: integer); 

integer; 

INTEGER; 



IMPLEMENTATION 

FUNCTION SUPER-^ODlA»B : INTEGER) 
^CALCULATES A*B MOD 



: INTEGER]; 
512 WITH <= 



A»B <= MAXINT3 



VAR TEMPI, TEMP2, TEMP3 : INTEGER? 

BEGIN 

TEMPI := (A MOD 1024 DIV 32) 
TEMP? := (A MOD 32) * (B MOD 
TEMP3 := (A MOD 32) * (B MOD 



* (B MOD 32) * 32 
1024 DIV 32) * 32 
32) MOD 512; 



MOD 
MOD 



5125 
512; 



SUPER.MOD 
END COF 



:= (TEMPI + 
SUPER. MOD}; 



TEMP2 + TEMP3) MOD 512; 



FUNCTION LITTLE. DIV(A,B,C : INTEGER) I INTEGER; 
BEGIN 

LITTLE-DIV := (A MOD 512 + 3 MOD 512 + C MOD 512) DIV 512; 

END LOF LITTLE.OIV3; 

FUNCTION SUPER-DIVCAiB : INTEGER) : INTEGER]; 

CCALCULATES A*B DIV 512 WITH <= A*B <= 2**24] 
VAR A_hI, A.MID, A-LOW, B-Hlt 8_MID» B_LOW : INTEGER? 
BEGIN COF SUHER.DIV: 

A_HI := A DIV 102^5 

A_MIQ := A MOD 1024 DIV 32 5 

A_LOw := A MOD 32t 

3_HI := 3 DIV 1024? 

B_MI0 := B MOD 102<+ DIV 325 

3_LOim := B MOD 32 5 

SUPER.DIV := A_HI * B_HI * 2048 + A_HI * B-MID * 6H + A.HI * B-LQW * 2 
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+ A_:4I:, * B_HI * 64 + A.MIn * B_Mln * 2 + A. MID * B.LOW DIV 16 

+ m_luw * tf_HI * 2 + A_LOW * B_MID DIV 16 + A_LOW * B.LOW DIV 512 

+ little-divu-mid * 5_l0w * 32»a_l0w * b.mid * 32»a-l0w * 3 low): 
end [of super_qivj; 

procedure fseek(*v,-.rt f: fib; recnjm: integer*); 

LABEL l; 

VAR 3YTE, SLOCK. N; INTEGER; 
BEGIN syscom^.iorslt : = INOERROR; 
IF F.FISOPEN THEN 
WITH F.FHEADER DO 
BEGIN 

IF (RECNUVI < 0) OR NOT FSOFTBUF OR 

((DFKIND = TEXTFILE) AND (FRECSIZE = 1)) THEN 
GOTO l; (*NO SEEK ALLOWED*) 
BLOCK := SUPERDIV(RECNUM, FRECSIZE) + 1; 

CRECNUM*FRECSIZE DIV FBLKSIZE + 1 ; 3 
BYTE := SUPERMODCRECNUM, FRECSIZE); 

C3YTL := RECNUM*FRECSIZE MOD FBLKSIZE; 1 
IF BYTE = THEN 
BEGIN 

BYTE := FBLKSIZE! 
BLOCK := BLOCK - 1; 
END! 

n := dlastblk-dfirstblk; 

IF (BLOCK > N) OR ({BLOCK = N) AND (BYTE >= DLASTBYTE)) THEN 

BEGIN BLOCK := N? BYTE := DLASTBYTE END; 
IF BLOCK <> FNXTBLK THEN 
BEGIN 

IF FBUFCHNGD THEN 

BEGIN FBUFCHNGD := FALSE; FMODIFIED := TRUE; 

UNITWRITE (FUNIT.FBUFFER, FBLKSIZE, DFIRSTBLK+FNXTBLK-1) J 
IF IORESULT <> ORD(INOERROR) THEN GOTO 1 
END; 
IF (BLOCK <= FMAX3LK) AND (BYTE <> FBLKSIZE) THEN 

BEGIN 

UNITREAD (FUNIT,FBUFFER, FBLKSIZE »DFIRSTBLK+BLOCK-l); 
IF IORESULT <> ORD(INOERROR) THEN GOTO 1 

END 

end; 

IF FNXTBLK > FMAXBLK THEN 

341 
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iEGIN F/JlAXbLK : = FNXTBLK; FHAXBYTE := F'JXTBYTC END 



c .l: 



if (fnxtijlk = fmaxblk) and (f jxtbyte > fmaxbyte) then 
fmaxbyte := fnxtgyte; 
fedf := falsl; feoln := false; freptcnt := o; 

IF FSTATE <> FJANDW THEN FSTATE := FNEEDCHAR! 
FNXTBLK := block; fnxtbyte := BYTE 

END 

else syscom~.io~<slt := inotopen; 

i: 

end <*fseek*) ; 

procedure freadreal(*var f: fi3j var x; real*); 

LABEL I? 

var ch: char; neg»xvalid: boolean; ipot: integer; 

BEGIN 

with f do 

3egin x := 0; neg := false; xvalid := false; 
if fstate = fneedchar then fget(f); 
while (fwindow^cod = » ») and not feof do fget(f); 
if feof then goto 1; 
ch := fwindowt03i 
if (ch = •+•) or (ch = •-•) then 

begin neg ! = ch = »-»; fget<f)5 ch := fwindowcod end; 
while (ch in digits) and not feof do 
begin xvalid := true; 
x := x*10 + (ord(ch)-ord( , 0» ) ) ; 
fget(f)5 ch j= fwindowcod 

END! 
IF FEOF THEN GOTO 1; 
IPOT := -11 
IF CH = •.' THEN 
BEGIN IPOT := 0; 

REPEAT FGET(F); CH != FWINDOWC D ! 
IF CH IN DIGITS THEN 

BEGIN XVALID := TRUE; IPOT := IPOT + l; 

X := X + (ORD(CH)-ORD( '0' ) ) /PWROFTEN ( IPOT ) 
E-MO 
UNTIL FEOF OR NOT (CH IN DIGITS); 
IF FEOF THEN GOTO 1 
END; 
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IF ((Ol = •[') OR (CH = •[')) AND (XVALID OR (IPOT < 0)) THEN 
it-Gin 

IF FSTATE = FJAND/J THEN FGET(F) 
ELSc FSTATE '.- FNEEDCHAR; 
FKE«\Jl;-,jT(F,iPOT) 5 
IF FCQF THE;j GOTO 1; 

IF .MOT XVALID THEM X := 1; XVALID := TRUE; 
IF IPOT < THEN X ;= X/PWR0FTEN(A3S(IP0T)) 
ELSE X := X*PwROFTEN( IPOT) 
ENDi 
IF XVALID THEN 

IF NEG THEN X := -X 
El.SE 
ELSE SYSCOlwr.IORSLT := IBADFORMAT 

enO; 
1: 

END (+FREADREAL*) ; 

PROCEDURE FWRITEREAL(*X:REAL; Wf d: INTEGER*); 
VAR Jt TRUNCX, EXPx: INTEGER; 

NORMX: REAL; s: STRINGC303! 

3EGIN 

(* CHECK W AND D FOR VALIDITY *) 

IF (w < 0) OR (D < 0) THEN BEGIN W := 0; D .'= END; 

<* TAKE ABS(X)* NORMALIZE IT AND CALCULATE EXPONENT *) 
IF X < THEN BEGIN X := -X! SCI] := •-• END 

ELSE SC1D := » •; 
expx := 0; NORMX ;= X; 

IF X >= PWROFTEN(O) THEN (* DIVIDE DOWN TO SIZE *) 
WHILE NORMX >= PWROFTENU) DO 
_BEGIN EXPX := EXPX+i; NORMX := X/PWROFTEN(EXPX) END 
ELSc 

IF X <> THEN (* MULTIPLY UP TO SIZE *) 
REPEAT 

expx := expx-i; normx := x*pi^roften(-expx) 
until normx >= pwroften(o); 

(* ROUND NUMBER ACCORDING TO SOME VERY TRICKY RULES *) 

IF (D=0) OH (D+EXPX+1 > 6) THEN (* SCIENTIFIC NOTATION, OR DECIMAL PLACES *) 
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NORM* := r-jOR^X + 5/PWR0FTiZN(6) (* OVLRSPECIFIED *> 

ELSE IF Q+EXPX+1 >- THEM 

■MCRVx := fJOR^X + 5/PWR0FTEM( J + EXPX + 1 ) ; 

(* IF T + EXPX + 1 < 0, THEN NUMBER IS EFFECTIVELY 0.0 *) 

(* IF -vE JUST BLEW NORMALIZED STUFF THEN FIX IT UP *) 
IF IMORviX >= PWROFTEN(l) THEM 

BEGIN EXPX := EXPX + l; NQRMX := NORMX/PWROFTEN ( 1 ) END; 

(* PUT THE DIGITS INTO A STRING *) 
FOR J := 3 TO 6 DO 
BEGIN 

TRUNCX := TRUNC(NORMX) 5 
SCj] := CHR(TRUNCX+ORD( '0 1 ) ) 5 
NORMX := (NORMX-TRUNCX)*PWROFTEN(l) 
END! 

(* PUT NUMBER INTO PROPER FORM *) 

IF (D=0) OR (EXPX >= 6) THEN (* SCIENTIFIC NOTATION *) 

BEGIN 

SU] := SC3D; 
SC33 := •••« 
J := 8; 

IF EXPX <> THEN 
BEGIN 

J := 9; 
SC9: := 'E'i 

IF EXPX < THEN 

begin J := io; scion := »-•; expx := -expx end; 

IF EXPX > 9 THEN 
BEGIN 

j := j+i; 

scj3 := chr(expx div 10 + ord(*0*)m 
end; 
j := j+i; 

SCJD := CHR(EXPX MOD 10 + ORDCOM) 

ESiD; 
SCC3 := CHR( J) ; 
END 
ELSE (* SOME KIND OF FIXED POINT NOTATION *) 
IF EXPX >= THEN 
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1< OV't.LLFT(5[i], SC2J, uX D X + l); 

Sr3+-£XPx:J := •.'; 

"ILLCHAK(SC93i D-(5-EXPX), » »); (* 3LANK FILL AT END IF PRECISION *) 

SCO] := CHR(3+J+LXPX) ; (* was OVER-SPECIFIED *) 

ENj 
ELSE 
BEGIN 

■10\/ERIGHT(SC33« SC3-EXPXD, 6); {* MAKE ROOM FOR LEADING ZEROES *) 

SL2H := '0' ; 

SC3J := •.'; 

FlLLCHAR(SC4]f -EXPX-1, 'O'li (* PUT IN LEADING ZEROES *) 

FILLCHAR(SC9-EXPX:, D-6+EXPX, • •);(* PUT IN BLANKS FOR OVER-PRECISION*) 

SCO 1 := CHR(3 + D) J 
END; 
IF w < LENGTH(S) THEN W : = LENGTH(S); 
FWRITESTRING( F. S, it )\ 
END; <*PRQCEDURE WRITE_REAL *) 

PROCEDURE FWRITEDEC(*VAR F: FIB; D: DECMAX; RLENG; INTEGER*); 

VAR s: STRINGC383; i: INTEGER; 

BEGIN 

STR(D,S) ; 

FWRITESTRING(F,S,RLENG) 
END (*FWRITEDEC*) ; 

PROCEDURE FREADDEC(*VAR F:FIB; VAR D: STUNT; L; INTEGER*); 
LABEL I! 

var ch: char; 

meg.qvalid: boolean; dig.i: integer; 

BEGIN 

WITH f DO 
3EGIIJ 

WITH D DO 
CASE L OF 

:= 0; 
:= 0; 

:= 0; 



2: W2 

5: W5 

e: we 
end; 

neg := false; dvalid := false; 



3: w3 := 0; 
6: w6 := 0; 
9: w9 := 0; 



4: W4 := 0; 
7: w7 := 0; 

10: wio := 



545 



34i 



615 


1 


4 


3 


Ibi 


618 


1 


4 


3 


ls><* 


617 


I 


4 


5 


liJb 


618 


1 


4 


.3 


192 


619 


1 


4 


5 


198 


620 


1 


4 


4 


20 7 


621 


1 


4 


3 


222 


622 


1 


4 


4 


?36 


623 


1 


4; 


5 


239 


624 


1 


4; 


5 


24<+ 


625 


1 


4: 


5 


251 


626 


1 


4, 


b 


254 


627 


1 


4! 


6 


257 


628 


1 


4, 


6 


284 


629 


1 


4; 


6 


311 


630 


1 


4! 


6 


338 


631 


1 


4: 


6 


365 


632 


1 


4 


16 


392 


633 


1 


4! 


!6 


419 


631 


1 


4 


!6 


446 


635 


1 


4 


!6 


473 


636 


1 


4 


16 


500 


637 


1 


4 


!5 


526 


638 


1 


4 


14 


533 


639 


1 


4 


!3 


538 


610 


1 


4 


'2 


548 


641 


1 


4 


.1 


550 


642 


1 


4 


,0 


550 


643 


1 


4* 





576 


644 


1 


4 


.0 


576 


645 


1 


1 


:o 





646 


1 


1 


;o 


480 


647 


1 


1 


so 


480 


648 





1 


:o 






IF FSTATl = KJEEQCHAR THEN FGETlF) 



• » ) AMD MOT FEOF DO FGET(F) 



• ) THEN 
FGET(F) ; 
NOT FEOF 



CH 

DO 



rtHILE (FwlMJUw^COI] = 
IF TEOF T.ltN GOTO 1; 

Zti := Fifji-jnow*co3; 
if (ch = •+» ) or (cm = • 
jlgin neg •= ch = •-♦ ; 
while (ch in digits) and 
3egin dval1d := true; 
dis:=okd(ch)-ord( *o* ) ; 
if neg then dig:=-dig; 

WITH D DO 
CASE L OF 

2:w2:=io*w2+dig; 
3:w3:=io*w3+dig; 
4:w4:=io*w4+dig; 
5:ws:=io*w5+dig; 
6:w6:=io*w6+dig; 
7:w7:=io*w7+Di5; 
8:w8:=io*w8+dig; 
9:w9:=io*w9+dig; 
io:wio:=io*wio+dig! 
END; 
fget(F); ch := fwindow*co3 
END; 
IF NOT- (DVALID OR FEOF) THEN SYSCOM* ♦ IORSLT 
END; 



FWINDOW^COD END; 



:= IBADFORMAT 



END{*FREADDEC*) i 



END C PASCALIO 3 ; 

(♦DUMMY lEVEl OUTERBLOCK*) 
BEGIN END. 



i. INCLUDE MACH.TyPE.TLXT 
.PROC DECOPS 

5 COPYRIGHT (C) 1976, THE REGENTS OF THE UNIVERSITY OF CALIFORNIA 
; SAN DIEGO CAMPUS 



DECIMAL OPERATORS 



• • i < i ' ' < < ' i < i * < i < < i < < i t i , t < t ; t ; ; ; ; ; ; ; ; ; ; 



MP .EQU 


R5 


IPC .EQU 


R<+ 


BASE .EQU 


R3 


3K .EQU 


R2 


;.if SOBSXT=0 


.MACRO SOB 




DEC 


%1 \ 


BNE 


%2 


.ENDM 




.MACRO SXT 




BPL 


$99 ; 


MOV 


8-liXl ; 


BR 


$98 ; 


$99: CLR 


%1 


S90: 




.ENDM 




;.endc 





; note: this macro version of sob does 

NOT(!) PRESERVE CONDITION CODES. 



this sxt macro does support all 
addressing modes. 
there must be a non-local label between 

ANY TwO SXTS IF LSI=0 



J TRAP PARAMETERS 
INTOVR .EQU 5 
DIVZER .E3U 6 
S2L0NG .EQU lb 
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r- « 
J H 



. JEF 



GQEC 



;dlc: 



DECIMAL INSTRUCTION 





mov 


(SP)+, EXTRTN 




MOV 


MP. DECMP 




mov 


IPC. DECIPC 




mov 


BASE, DECBAS 




MOV 


BK. DECBK 




MOVB 


(SP)+«R1 




mov 


0ECT3L(RD.PC 


3IGRTN: 


MOV 


DECMP, MP 




MOV 


DECIPC, IPC 




MOV 


decbas. base 




MOV 


DECBK, BK 




MOV 


EXTRTN. PC 


decmp: 


• WORD 





decipc: 


.WORD 





DECBAS: 


.WORD 





DECBK; 


• WORD 





extrtn: 


.WORD 





3ECTBLI 


.WORD 


DAJ 




.WORD 


DAD 




.WORD 


DSB 




.WORD 


DNG 




.WORD 


DMP 




.WORD 


DDV 




.WORD 


DSTR 




.WORD 


DCV 




.WORD 


DECCMP 




.WORD 


DCVT 




.WORD 


DTNC 


;.IF SMLI^l 




smli: 


MUL 


R5.R4 




RTS 


PC 


5.ELSE 




J SOFT MULT 


■ili : 


5 ,-OFT 


MULTIPLY (R^ 



; SAVE RETURN ADDRESS 
; SAVE REGISTERS 



; GRAB INSTRUCTION BYTE 
; AND GO EXECUTE 

; RESTORE REGISTERS 



; TRICKY RETURN TO CALLING ROUTINE 



LY IF NO HARD MULTIP^^ 
<R<+,R5) :=R5 X R4- 





MOV 


ROiSAVO 




y\o\j 


RliSAVl 




CLR 


-(SP) 




TST 


K5 




BGT 


SI 




SEQ 


ZEROM 




INC 


asp 




NE3 


R5 




BMI 


SPECL1 


si: 


TST 


R<4 




BGT 


S2 




BE3 


ZEROM 




INC 


3SP 




NE3 


R4 




BMI 


SPECL2 


$2: 


MOV 


#16.,-{Sp) 




CMP 


R5.R4 




BGE 


MCLR 




MOV 


R5fR0 




MOV 


R4.R5 




MOV 


RO»R<+ 


mclr: 


CLR 


RO 




CLR 


Rl 


mmul: 


ROR 


R4 




BCC 


SI 




ADO 


R5iRl 




ADC 


RO 




CLC 




si: 


ROR 


RO 




ROR 


Rl 




BCC 


CYC 




SIS 


#100000»RO 


:yc: 


DEC 


asp 




BGT 


MMUL 




TST 


(SP) + 




MOV 


R0.R5 




MOV 


ri.r<+ 




ROR 


(SP) + 




BCC 


OUTM 




COM 


R<+ 




NEG. 


R5 



SAVE REGISTERS 

SIGN STORAGE 
CHECK MULTIPLICAND 
SKIP FOLLOWING IF + 
ANSWER IS ZERO 
REMEMBER NEGATIVE 

; SPECIAL HANDLING FOR 
; TEST MULTIPLIER 



-32768 



SET UP ITERATION COUNT 

MAKE SURE 

MULTIPLIER 

IS 

SMALLER 



; CLEAR PRODUCT 

GET MULTIPLIER BIT 
= 0? 

NO, ADD IN MULTIPLICAND 



J ROTATE PRODUCT 



GET RID OF CUUNTER 

PUT RESULT IN OUTPUT REGISTERS 

NOTE REVERSAL OF REGISTERS 

DETERMINE SIGN 

OF PRODUCT 
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vJJ( 







£1 




INC 


KH 


ti: 


3R 


OUTM 


3PECL2: 


MOV 


R5iR«t 


specli: 


CLR 


R5 




ASR 


<SP) + 




3NE 


$1 




NEG 


R4 


ii: 


ASR 


R4 




3CC 


OUTM 




ROR 


R5 




TST 


RM- 




BPL 


OUTM 




INC 


R<+ 


outm: 


MOV 


SAVO.RO 




MOV 


SAVl»R.l 




RTS 


PC 


zerom: 


CLR 


R<+ 




CLR 


R5 




TST 


(SP) + 




BR 


OUTM 


savo: 


.WORD 




savi: 


.wORD 




; .ENDC 







; R<+ WAS -327&e 

; ELSE Rb WAS -32768 

; WAS R5 NEGATED ALREADY? 

; YES 

; NO NEGATE fJUW 

; DIVIDE 3Y 2 



FIX FOR NEGATIVE 
ODD NUMBERS 

RESTORE REGISTERS 



daj: 



; DECIMAL ADJUST 



XPAND 



shrink: 
jLOOP: 



MOVB 

SJ3 

3E3 

3LT 

TST 

SXT 

MOV 

SOS 

BR 

NEG 

TST 

BE3 

INC 

BEO 



(SP)+iR0 
(SP)+.RO 
DAJDNE 
SHRINK 

asp 

Rl 

Rl.-(SP) 

RO, XPAND 

DAJDNE 

RO 

(SP) 

DPOS 

(SP) + 

DNEG 



; GET DESIRED LENGTH 

; TOSS OPERAND LEN! RO = DIFF 



; SIGN EXTENSION 



hole: jmp 
onlg: tst 

3Pl. 
SOd 
BR 
opos: TST 

TST 

a uii 

SOB 

oajdne: jmp 



dc\/t: 



dtnc: 



omg: 



MOV 

JMP 

MOV 
BR 



DOVR 

(SP) 

HOLE 

RO.DLOOP 

OAJDNE 

(SP) + 

(SP) 

HOLE 

RCDLOOP 

i#BlSRTN 

#lt-(SP) 

d)#BIGRTN 

ttli-(SP) 
DAJ 



; DECIMAL NEGATE 
MOV SP.R1 
JSR PC»OOQNG 
JMP StfBIGRTN 



; OVERFLOW 

; OVFL OCCURRED 

; KNOCK SP 

; EXIT DECOPs 

; PUSH LENGTH WORD OF 1 

; PUSH DESIRED LENGTH OF 1 



; EXIT DECOPS 



DODNG: ; NEGATE SUBROUTINE.. 3K IS DESTROYED 



$1 



$2; 



MOV 


<R1),BK 


ASL 


BK 


ADD 


RXtBK 


MOV 


(Rl) fRl 


TST 


(BK) + 


SEC 




BCC 


CRYCLR 


COM 


-(BK) 


ADD 


SI. (BK) 


SOB 


R1.S1 


3VC 


DNGEND 


TST 


-(BK) 


TST 


-(SP) 


MOV 


SPiRl 


MOV 


2(R1) , ( 


CMP 


Rl.BK 


3L«t 


S2 



Rl POINTS TO LENGTH UPON ENTRY 

BK POINTS TO LSB 
NOW Rl HAS LENGTH 



INSERT EXTRA WORD 



(Rl> + 
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tst 


2(3K) 




sxr 


(sK) 




w^ 


DN3ENU 


:ryclr; 


COM 


-(BK) 




SOB 


Rl.CRYCLR 


jngend: 


MOV 


BKtRl 




TST 


-<iU) 




RTS 


PC 


j S3: 


5 DECIMAL SUBTRACT 




MOV 


SPtSUBFLAG 




JSR 


PCiADDSUB 




BR 


DCH 


dad: 


5 DECIMAL ADD 




CLR 


SUBFLAG 




JSR 


PC.ADDSUB 




BR 


DCH 


addsub: 


MOV 


(SP)+,ASRET 




MOV 


(SP)»R0 




ASL 


RO 




ADD 


SP.RO 




TST 


(RO) + 




CMP 


aRO»asp 




BE3 


GOADD 




JSR 


PCtDECADj 


soadd: 


MOV 


(RO).BK 




ASL 


(RO) 




MOV 


R0.R1 




ADD 


(RO) ,R0 




TST 


SJBFLAG 




BE3 


ADLOOP 




3R 


SU3BER 


sbloop: 


SBC 


-(RO) 




BCC 


$1 




SUB 


-(Rl) , (Ro) 




SEC 






BR 


SUB2 


si: 


3VC 


SJ3BER 




SJ3 


-(Rl) , (RO) 



; RESTORE Rl TO ORIG. VALUE 



; NONZERO VALUE INDICATES SUBTRACT 



; ZERO INDICATOR FOR ADD 



SAVE RETURN ADDR 
GET LENGTH 
FOR BYTES 

POINT RO TO 2ND OP LEN 

COMPARE LENGTHS 

EQUAL - O.K. 

GO MAKE EQUAL 

BK HAS LENGTH (WORDS) 

RO POINTS TO LENGTH (3YTES) 

Rl POINTS TO OP 1 LSB + 1 WORD 

RO POINTS TO OP 2 LSB 

ADD OR SUBTRACT? 



; CARRY 

; IF HEREi MUST PASS ON CARRY 

; KEEP TRACK OF OVERFLOW 





3R 


SJ33 


3UBSER: 


SJ3 


-(Rl) , (Rq) 




3VC 


SUB2 


5UB3: 


S03 


BKiS3L00p 




acz 


NWORD 




3R 


ZWORD 


SU32: 


SOB 


BK.SBLOOP 




BR 


NOXTRA 


dadi: 


ADC 


-(RO) 




BCC 


$1 




MOV 


-(Rl) , (Rq) 




S03 


1 BKtDADl 




BR 


NOXTRA 


si: 


BVC 


ADLOOP 




ADD 


-(Rl) i(R0) 




BR 


OLOOP 


adloop: 


ADD 


-(Rl) , (Ro) 




BVS 


OLOOP 




SOB 


BKfDADl 




BR 


NOXTRA 


oloop: 


SOB 


BK.DAD1 




3CC 


ZWORD 


nword: 


MOV 


8-1, -(RO) 




BR 


PUTLEN 


zword: 


CLR 


-(RO) 


putlen: 


ADD 


#1,(SP) 


noxtra: 


MOV 


(SP).-(Ro) 




MOV 


ROfSP 




JMP 


a(Po + 


asret: 


.WORD 




SUBFLAG; 


I.WORD 





PERFORM SUBTKACTION 
SEPARATE LOOP-END FOR OVFL 



j FINISHED SUBTRACTION W/O OVERFLOW 

; ADD CARRY BIT IN 

J IF ADDEND WAS -1 THEN RESULT IS WITH 

; CARRYt SO JUST MOVE 2ND ADDEND 

; AND KEEP CARRY. 

; IF OVERFLOW THEN 

} KEEP TRACK OF IT 

; MOVE Rl AND ADD 

; SEPARATE LOOP-END FOR OVFL 

5 FOR EACH WORD PAIR 

; EXTRA WORD NOT NEEDED 

; RESULT POSITIVE 

; RESULT NEGATIVE 

; PUT SIGN EXTENSION IN 

; INCREASE LENGTH BY ONE 

; PUT LENGTH IN RESULT 

; ADJUST SP 

; RETURN 

; ADD/SUBTRACT INDICATOR 



DECADJ: ; THIS ROUTINE MaKES 2 DECIMALS, 

? (TOS) AND (TOS-1), OF EQUAL LENGTH. 

; (SP)=UPPER LENGTH (WORDS) 

; (RO) =LOirfER LENGTH (WORDS) 

; SAME CONDITIONS ON OUTPUT 

; REGISTERS BK.Rl ARE DESTROYED 

MOV (SP)+,DRET ; SAVE RETURN ADDR 

MOV 3ASE,3ASSAV ; SAVE REG 

MOV aSP,Rl 
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SJd 


3R0»*1 


j R1=LEN OIFF (WORDS) <> 




ASL 


F<1 


; CHANGE TO BYTES 




iLT 


TOP 


, 30 EXPAND TOP DECIMAL 




MQV 


SP»QK 


• SAVE OLD tos 




SUB 


RltSP 


• MAKE ROOM FOK EXPANSION 




MQV 


SPiBASE 


POINTS TO NEW TOS 


shifti: 


MOV 


(3K)+i (BaSE)+ 


SHIFT WORDS 




CMP 


3K,R0 


UNTIL ENTIRE TOP 




3LT 


SHIFTI 


OPERAND SHIFTED 




MOV 


BASE.RO 


POINT RO AT BOTTOM LENGTH 




MOV 


(SP) . (RO) 


PUT IN BOTTOM LENGTH 




BR 


FILL 




top: 


NEG 


Rl 






MOV 


SPtBK 


SAVE OLD TOS 




SUB 


RliSP 


UPDATE SP 




MOV 


(R0)f (SP) 


SET LENGTHS EQUAL 


fill: 


TST 


2(BK) 


FILL WITH ZEROES OR ONES? 




SXT 


BASE 


SIGN EXTENSION 




ASR 


Rl 


BACK TO WORDS 


si: 


MOV 


BASE, (BK) 


MOVE FILLER 




TST 


-(BK) 


DECREMENT BY 2 




S03 


RltSl 


UNTIL FULL 




MOV 


BASSAV»BASE 


RESTORE REG 




JMP 


3(PC)+ 


RETURN 


dret: 


.WORD 






3ASSAV: 


.WORD 






dch: 


; CHECK 


DECIMAL LENGTH 






CMP 


ttlO. , < SP) 


CHECK LENGTH (WORST CASE 




3LT 


DOVR 


OVERFLOW IF TOO LONG 




JMP 


SlttBIGRTN 




dovr: 


TRAP 


INTOVR 


OVERLFOW 



(FUTURE) 



QMP: ; DECIMAL MULTIPLY 
JSR PCtOMJL 
3R DCH 



; CHECK FINAL LENGTH AND LEAVE 



ipcsav: .WORD 



'"MUL: 



$1 



zprod; 



si: 



dget: 



SI 



jSETUp; 



"1 \/ (SP) + , JMpRET 

MOV/ iPCilPCSAV 

CLR iJEGl 

MOV/ (SPJ+.RO 

TST (SP) 

6PL $1 

MOV R0»-(SP) 

MOV/ SPtRl 

JSR PC.DOUNG 

INC NEG1 

MOV/ (SP) + f R0 

TST (SP) 

BNE DGET 

TST (SP)+ 

SOB R0t$l 

J IF HERE THEN PRODUC 

J FILL MULTIPLICAND W 

MOV/ (SP)tRO 

MOV/ SPtRl 

TST (Rl)+ 

CLR (Rl)+ 

SOB R0t$l 

JMP DMPEND 

MOV/ ROtRl 

ASL Ri 

ADD SPtRl 

MOV/ (R1) + ,R2 

TST (Rl) 

3PL $1 

TST -(Rl) 

JSR PCtDODNG 

DEC NEG1 

MOV/ (Rl) + tR2 

TST (Rl) 

BNE DSETUP 

TST (Rl)+ 

SOB R2t$l 

ASL RO 

ADD ROtSP 

JMP DMPEND 

MOV SPtR3 



; SAVE RETURN ADDR 

; R0-R5 USEJ 

; NEGATIVE REMEMBERER 

; POP OFF MULTIPLIER LENGTH 

; CHECK FOR NEG SIGN 

; SETUP FOR CALL 

; ABS VALUE RETURNED 

; REMEMBER 

; REPEAT OF ABOVE SETUP 

; GET RID OF LEADING ZEROES 

; INCREMENT TO NEXT LEADING DIGIT 

T IS ZERO 

ITH ZEROES AND EXIT 
; PUT LENGTH IN RO 

5 INCREMENT Rl TO MSB 

; CLEAR ALL WORDS 

; HERE GET RID OF MULTIPLICAND ZEROES 

; FIRST LOCATE LENGTH 

; AND PUT IN Rl 

; NOW R2 HAS LENGTH AND Rl POINTS TO MSB 

; CHECK NEG. 

J DECREMENT TO POINT TO LENGTH 

J FOR CALL TO ABS VALUE GETTER 

; IF BOTH OPS NEG THEN ZERO RESULTS 

; REPEAT OF ABOVE STMT 

; SAME LEADING ZERO PROCESSING 



OOPS IT WAS ALL ZEROES 
ADJUST SP AND LEAVE 

SP POINTS TO M'PLIEF 'SB. .NEEDED LATER 
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,-ov 


i<2.R4 




AOO 


R0.R4 




MOV 


R<4tLE:JSAy 


si: 


CLR 


-(SP) 




SOi 


U4.S1 




mjv/ 


R2»L2SAV 




CLK 


POSSAV 




mov 


ROt COUNT 




MOV 


SP.RO 




BR 


DMULT 


hiloop: 


MOV 


RECOUNT 




MOV 


POSSAV1R0 




TST 


(RO) + 




MOV 


R0«POSSAv 




ADD 


SP,R0 




MOV 


L2SAV.R2 




SUB 


R2»R1 




SUB 


R2tRl 




TST 


(R3) + 


dmult: 


MOV 


(R3) fRf 




MOV 


<R1) ,R5 




TST 


R«+ 




BPL 


$1 




TST 


R5 




BPL 


$2 




AOO 


R5iR«+ 




BR 


$3 


si: 


CLR 


ADJSAV 




TST 


R5 




BPL 


DOOIT 




3R 


$3 


52: 


MOV 


R5.R4 


S3: 


MOV 


R4»ADUSA\/ 




MOV 


(R3) ,R*f 


DOQIT: 


MOV 


(RD + .R5 




JSR 


PC»MLI 




ADO 


ADJSAV,Ri+ 




ADD 


R<+. <R0) + 




3CC 


si 




DEC 


RO 




DEC 


RO 



CONSTRUCT PRODUCT LENGTH NOW 
EQUALS SUM CH OPR. LENGTHS 

CLEARING AREA FOR PRODUCT ON TOP OF STACK 

MULTIPLICAND LENGTH 

POSSAVsLEADlNG CURRENT POSITION IN PRODUCT 

MULTIPLIER LENGTH 

RO WILL BE CURRENT PRODUCT WORD 

RE-SAVE COUNT OF M»PLIER WORDS 
INCREMENT TO NEXT PRODUCT POSITION 



; SET UP RO TO POINT TO IT 
; REINIT LOOP COUNT 

BACK TO BEGINNING OF M'CAND 

KICK M'PLIER INDEX 

MULTIPLIER WORD 

M'CAND WORD 

PERFORM TWO'S COMPLEMENT ADJUSTMENTS FIRST 



; BOTH NEG. - IGNORE OVERFLOW HERE 

; ENSURE CLEAR FOR NO ADJUSTMENT 

BOTH POS. 

R5 NEG.. ADD R<+ 

R«* NEG.t ADD R3 

ADJUSTMENT FOR Hi ORDER HALF OF PRODUCT 



TIMES M'CAND WORD 
STICK IN ADJUSTMENT 
HI-ORDER PROD 

RE-ALIGN RO 



- IGNORE CARRY 



MOV NNNiR3 

13: CLR -(SP) 

S03 R3i$3 

rJ !OV AADD.R4 

MOV MMMtRS 

TST (RH) + 

St: MOV -(R4)«-(sP) 

SOB R5»$f 



5 MAKE N WORDS OF ZEROS FOR 6. 



MOVE M WORDS FROM AADD TO TOP OF STACK 



.INCLUDE DECOP.B.TEXT 



MOV NNN*R5 

SUB MMM»R5 

BEQ $6 

BPL $5 

JMP BOMB 

$5: MOV BSISN.-(sP) 

SOB R5»$5 

$&J MOV CADD»R4 

MOV AADD.R5 

CMP (RH)+,(R5)+ 

MOV NNN»R3 

*7: MOV -<R*U.-(R5) 

CLR <R4) 

SOB R3i$7 

MOV TW0N,R3 

ASL R3 

MOV R3.LENG 

TST -(R3) 

MOV AADD,AWS 

SUB R3.AWS 

MOV 6ADD,BWS 

SU3 R3.BWS 

MOV AADD,R2 

MOV TW0N,R3 

JSR PCtLASL 

MOV AAD0,R2 

MOV TWON,R3 

JSR-' PCLASL 



J ADJUST Rf AND R5 

5 MOVE A AND CLEAR C. 

; SAVE LONG LENGTH IN BYTES 

; SAVE ADDRESS OF SIGN WORD OF A, 

; SAVE ADDRESS OF SIGN WORD OF B. 



; ADJUST A FOR PROPER/ "VISION. 
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ddvb: 



si: 

$2: 



mdl: 
si: 



sxtbrk; 



DIVISION BEGINS HERE. 
ASIGN.BSlGN 
SI 
PC.LAUDAR 

$2 
PCiLSuBAB 

PC.LSLC 

TW0N.R5 

R5 

R5 

R5 

-(R5) 

; MAIN DIVISION LOOP BE 

JSR PC.LSRB 

TST SAWS 

SXT RO 

TST 3BWS 

SXT Rl 

CMP ROiRl 

BEQ $2 

JSR PC.LADDAB 

CLC 



C«IP 
JSR 

se: 

3R 

JSR 

CLC 

JSR 

MOV 

ASL 

ASL 

ASL 

TST 





3R 


$3 


$2: 


JSR 
SEC 


PCLSUBA3 


$3: 


JSR 


PC.LSLC 




SOB 


R5.MDL 


eomdl: 


; END 
SEC 


OF MAIN DIVISION 




JSR 


PC.LSLC 




TST 


cDAWS 




SXT 


R5 




CMP 


R5.ASIGN 




BEO 


$6 




TST 


ASIGN 




3NE 


$3 



SIGN OF A IS NOT SAME AS SIGN OF 3 
SO A;=A+B AND ANSWER WILL BE NEGATIVE 

SIGN OF A SAME AS SIGN OF B SO A:=A-B 
AND ANSWER WILL BE POSITIVE. 
SHIFT CARRY LEFT INTO LSBIT OF C 
ON A 16 BIT MACHINE THE NUMBER OF REPITITIONS 
IS <NUMBER OF WORDS IN A> X 
<16 BITS PER WORD> - 2 

R5 CONTAINS THE NUMBER OF REPITITIONS FOR 
THE MAIN DIVISION LOOP. 
INS HERE. 
SHIFT TRIAL DIVISOR LEFT. 



IF EQUAL THEN PARTIAL REMAINDER AND TRIAL 
DIVISOR HAVE THE SAME SIGN. 
SIGN OF PR AND TD DIFFERENT 

so pr:=pr+td (a:=a+3) 

AND SHIFT A ZERO INTO LSBIT OF QUOTIENT 

c:=(c$2)+o 

SIGN OF PR AND TD SAME SO PR:=PR-TD (A:=A-B) 
AND SHIFT A ONE INTO LSBIT OF Q. C:=(C$2)+1 
ACTUALLY DO THE SHIFT ON C. 



LOOP 



SHIFT A ONE INTO LSBIT OF C, 



IF SIGN OF A EQUALS SIGN OF REMAINDER THEN 

BRANCH TO $6 ELSE 

IF A<0 THEN 

ANSWER CORRECT ANQ^jJLONE 



tW 



=6: 



$8: 

$2: 

$7: 
$3: 

LEAVE: 

bomb: 



lslc: 



lasl: 

bslc: 
si: 

eosl: 

lsrs: 



TST 

3Eo) 

3R 

TST 

BEQ 

TST 

8EQ 

BR 

MOV 

MOV 

TST 

SEC 

ADC 

BCC 

SOB 

BR 

BIC 

MOV 

TST 

JMP 

MOV 
CLR 

MOV 

BR 

MOV 
MOV 
ROL 
DEC 
BEO 
BR 

TST 

• 

ROL 
SOB 
RTS 

MOV 
MOV 



3SIGN 

$7 

S3 

ASIGU 

33 

3SIGN 

$7 

$8 

NNN.RO 

CADDtRl 

(Rl) + 

"(Rl) 

$3 

R0»$2 

$3 

ttl.aCADD 

AADD.SP 

<SP) + 

38BIGRTN 

CADD,SP 

(SP) 

tfli-(SP) 

LEAVE 



; OTHERWISE 

; IF B>=0 THEN S7 ELSE 

; IF 3<0 THEN $8 

; IF A>=0 THEN DONE OTHERWISE 

; IF B>=0 THEN $7 ELSE 

; IF 6<0 THEN *8. 

; DO LONG ADD C=C+1 

; PREFORMED ONLY WHEN 3>=0 



J EARLY TERMINATION OF LONG ADDITION 

J END OF ADDITION C=C+1 

J IF B<0 THEN CLEAR LSBIT OF C AND FINISHED. 

? ADJUST STACK POINTER 

; AND LEAVE. 
5 EXIT DECOPS 

J THIS IS THE ERROR CASE. IT CURRENTLY 

5 SETS THE ANSWER TO ZERO. IN THE FUTURE IT 

} WILL GENERATE AN ERROR TRAP. 



CADD,R2 

NNN»R3 

(R2) 

R3 

EOSL 

BSLC 

; long arithmetic shift left 

<R2) + 



-<R2) 
R3i$l 

PC 

3WS.R2 
TaIONi R3 



{RETURN FROM ARITHMETIC SHIFT LEFT 
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i- ask: 



si 



ccsr: 



laddab: 



LAQD 

$1: 



$2! 



S3: 

eoladd; 



lsubab: 



lsub: 
$i: 



$2 



S3: 

eolsub: 



ASR 
DEC 
3E3 
ROR 
SOS 
RTS 

MOV 
MO\/ 
MOV 
CMP 
ADD 
MOV 
DEC 
BE3 
MOV 
3CC 
ADC 
SOB 
S03 



; END 
RTS 

MOV 

MOV 

MOV 

CMP 

SU3 

MOV 

DEC 

BE3 

MOV 

3CC 

SBC 

303 

S03 

; END 

RTS 

; THIS 



(R2) + 

hi 

EDSR 

(R2) + 

R3t$l 

PC 

AADD,RO 
BADD.nl 
TW0N.R2 
(RO) + ,(RD + 
-(Rl) ,-(R0) 
R2iR3 
R3 
$3 

R0.R4 
$3 

-<R*f) 
R3.S2 
R2.S1 
OF LONG ADD. 
PC 



AADD,RO ; 

BADD.R1 

Twl0N,R2 

(RO) + i(RD+ ; 

-(Rl) ,-(rO) 

R2»R3 

R3 

$3 

R0»R4 

$3 

-(R4) 

R3.S2 

R2t$l 

of long subtract. 

PC 

is the end of ddv. 



LONG ARITHMETIC SHIFT RIGHT 



; RETURN FROM ARITHMETIC SHIFT RIGHT 



A = A + B 



ADJUST ADDRESSES 



A=A-B 



ADJUST ADDRESSES 



; FOLLOWING ARE STATIC STORAGE WORDS OF DDV. 



'A M M ; 


.WORD 




■mnn: 


.WORD 




twon: 


♦ WORD 




leng: 


.WORD 




aws: 


.WORD 




3ws: 


.WORD 




asign: 


.WORD 




3SIGN: 


.WORD 




<\add: 


.WORD 




badd: 


.WORD 




cadd: 


.WORD 




dvipc: 


.WORD 




deccmp: 


! COMPARE DECIMALS 




MOV 


(SP)+,RQ 




ASL 


RO 




MO\/ 


SBROPS(R0)»$5 




MOV 


UBROPS(R0>«$2 




MOV 


(SP)iRO 




ASL 


RO 




ADO 


SPtRO 




TST 


(RO) + 




CMP 


aRo»asp 




BEQ 


$8 




JSR 


PCiDECADj 


$s: 


MOV 


(RO) .BASE 




ASL 


BASE 




ADD 


RO.BASE 




TST 


(R0) + 




MOV 


(SP)+,BK 




CMP 


(R0)+,(Sp)+ 




BNE 


$5 




3R 


$7 


si: 


CMP 


(RO)+, (Sp)+ 




3ME 


$2 


$7: 


S03 


BK,$1 


$2: 


NOP 






BR 


$1+ 




3R 


$6 


$5: 


NOP 





; GET COMPARISON TYPE INDEX 

? PUT IN SIGNED CMP OPR 

; PUT IN UNSIGNED OPR 

J PROCESSING TO POINT RO AT LEFT OPR LENGTH 



{ RO NOW POINTS TO LENGTH 
$ COMPARE LENGTHS 

I MAKE LENGTHS EQUAL 

J BASE WILL HOLD ADDR OF RESULT 

? BASE NOW POINTS TO RESULT 
RO POINTS TO LEFT OPR MSB 

SP POINTS TO RIGHT OPR MSB; BK HAS LENGTH 
COMPARE SIGN WORDS 



; COMPARE UNSIGNED WORDS 
; ANY NEQ STOPS LOOP 

; UNSIGNED COMPARE OP GOES HERE 



; SIGNED CMP OP HERE 
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Jb 





a< 


$4 


$b: 


MOV 


»»lt (BASE) 


S3: 


MOV 


dASE,SP 




J^IP 


a#8IGKTN 


$4: 


CLR 


(BASE) 




3R 


$3 



i EXIT DECOPS 



ostr: 



si: 

$2; 



$3: 



INITIALIZE 

SIGNIFICANCE FLAG 

SHIFT COUNTER 

FOR DODNG AND LATER PROCESSING 

NEGATIVE? 



DECIMAL TO STRING CONVERT 

REGISTER ASSIGNMENTS: 

IPC = POWER OF TEN INDEX 

BASE = POINTER TO STRING 

MP = POINTER TO LAST CHAR IN STRING 

BK = DECIMAL LENGTH 

MOV CSP)+»SLENG 

MOV (SP)+,BASE 

MOV BASEtMP 

INC MP 

MOVB 81, (BASE) 

MOVB # M 0"»(MP) 

CLR SIGNIF 

CLR ZCOUNT 

MOV SP,R1 

TST 2(SP) 

BGE $1 

JSR PC»DODNG 

MOVB #»-», (MP) 

INCB (BASE) 

INC MP 

MOVB #"0"»(MP) 

MOV (SP),BK 

TST (Rl)+ 

TST (Rl)+ 

BNE $3 

SOB BK«$2 

MOV RltSP 

3R STREND 

TST -(Rl) 
BGE $4 
TST -(Rl) 
INC 3K 



; MAKE POSITIVE 

; INSERT MINUS SIGN 



INCREMENT TO SIGN WORD 

GET RID OF LEADING ZEROES 

-(Rl) WAS NONZERO 

BK KEEPS TRACK OF LENGTH 

IF HERE* NUMBER WAS ZERO 

SO POP DECIMAL AND LEAVE 

CHECK SIGN BIT - SHOULD BE POSITIVE 

RESTORE A WORD OF ZEROES 



C4 



cend: 



*t: mov OK»-(Ri) 
mgv ri,sp 

? now choose appropriate 

CMP 3Kt#2 

33T C<+ 

MOV rtP0T2,IPc 

BR CEND 

CW 3K»tf4 

3GT C3 

MOV SP0T4.IPC 

BR CEND 

MOV #P0T8.lPc 

5 HERE COMPARE INPUT TO 

CMP (SP),(IPC) 

3GT $1 

BIT DLESS 

CMP 2(SP),2(IPC) 

BLO DLESS 

; ELSE ASSUME DECIMAL GR 

si: JSR PC.CLOAD 

MOV SP,SUBFLAG 

JSR PCiADDSUB 

; TEST FOR ZERO OR LESS 

TST 2(SP) 

3LT RESTOR 

IMCB (MP) 

INC SIGNIF 

MOV (SP)»R1 

TST (SP)+ 

$2: TST (SP) 

BLT $3 

BNE s<+ 

TST (SP)+ 

SOB RliS2 

BR TRAIL 

S3: CLR -(SP) 

IMC Ri 

St: MOV Rli-CSP) 

3R CEND 

RESTOR: JSR PCiCLOAD 

CLR- SUBFLAG ■ 



; PUT ON LENGTH TO MAKE 

; A COMPLETE (SHORTER) DECIMAL 

POWER OF TEH 
; DECIMAL LEN <= 2 ? 

; YES* POINT IPC TO RIGHT P.O.T. 

5 DECIMAL LEN <= «f ? 



POT 
COMPARE LENGTHS 
DECIMAL LONGLR (GREATER) 
DECIMAL SHORTER (SMALLER) 
COMPARE MSB WORDS 
DECIMAL SMALLER 
EATER OR EQUAL FOR NOW 



PUT POT ON STACK 
SET NONZERO FLAG 
AND SUBTRACT (NOTE 



NO REG SAVE) 



OOPS DECIMAL WAS SMALLER 

ALSO INCREMENT STRING HERE 

AND SET FLAG 

LENGTH 

INCREMENT 

LOOP TO TEST FOR ZERO 

RESULT AND ALSO 

SHORTEN DECIMAL 

BY REMOVING LEADING ZEROES 

DIFFERENCE ZERO - CONVERSION COMPLETE 

HERE, RETAIN EXTRA LEADING 

ZEROES FOR POSITIVE SIGN 

LENGTH 

DO IT AGAIN 

INDICATES ADD 



r ^ i ZZ 

JUD 



O L) o 



.LESS: 



TRAIL; 



Si: 



strend: 



si: 



JSR 
MOtf 

■■10 V 

mov 

JSR 

MOV 

r^lOV 

INC 

TST 

8E0 

INCB 

IMC 

MOVB 

3R 

5 HERE. 

MOV 

SUB 

3EQ 

INCB 

INC 

MOVB 

SOB 

CMPB 

BLOS 

TRAP 

JMP 



PCADOSU5 

MPiCHSAV 

BASE.BASLSV 

ttlO.t-(Sp) 

tfl.-(SP) 

PCiDMUL 

CHSAV.MP 

BASESV.BASE 

ZCOUNT 

SIGNIF 

CEND 

(BASE) 

MP 

#"0". (MP) 

CEND 

ADD TRAILING 

-(IPC)tRO 

ZCOUNT, RO 

STREND 

(BASE) 

MP 

#"0%(MP) 

R0.S1 

aBASE.SLENG 

$1 

S2L0NG 

a#3IGRTN 



; FALLS INTO DLESS 

; SAVE REGS EXCEPT IPC 

; PUSH D 10 ON STACK 

; AND MULTIPLY 

; RESTORE 

; COUNT THE SHIFT 

; DON'T PUT OUT A NON-SIGNIF. ZERO 



; REPEAT PROCESS FOR NEXT DIGIT 
BLANKS 

; NO. OF ZEROES IN POT 

; THESE DIGITS ACCOUNTED FOR 

; IF NO TRAILING ZEROES 



; CHECK STRING LENGTH 



? EXIT DECOPS 



CLOAD: ; LOAD A POWER OF TEN 

MOV (SP)+.$3 

MOV (IPC).RO 

INC RO 

MOV IPC.R1 

ADD R0»R1 

ADD ROtRl 

Si: MOV -(Rl).-(SP) 

SOB RO*$l 

TST 2(SP) 

BGE $2 

MOV. (SP).-(Sp) 



SAVE RETURN ADDR 

LENGTH 

INCLUDE LENGTH IN TRANSFER 



; NOW Rl POINTS TO LSB + 2 



; IF SIGN BIT USED 
; THEN MAKE POSITIVE 





ZLR 


2(SP) 




INC 


(SP> 


*2: 


JMP 


n](PC) + 


i.3: 






chsav: 


.WORD 




3ASESVI 


.WORD 




3LENG: 


. -.dORD 




signif: 


.WORD 




zcount: 


. WORD 




P0T2 


.E3U 


* + 2 




.WORD 


9. 




.WORD 


2 




.WORD 


035632 




.WORD 


14500C 


P0T4 


.EQU 


* + 2 




.WORD 


19. 




.WORD 


4 




.WORD 


105307 




.WORD 


021404 




.WORD 


104750 




.WORD 


000000 


P0T8 


.EQU 


* + 2 


; NOTE 


ANY NUMBERS GREATER 


5 ARE MISREPRESENTED 




.WORD 


38. 




.WORD 


3. 




.WORD 


045473 




.WORD 


046250 




.WORD 


055206 




• WORD 


142172 




.WORD 


004612 




.WORD 


021100 




.WORD 


000000 




.WORD 


oooooa 



THAN 



RETURN 



DOUBLE OUTY 



STORAGE FOR 10**9 (MAX 2-WORD PWR OF TEN) 

NUMBER OF f S IN 10**9 

LENGTH 

OCTAL REPRESENTATION (HI-ORDER FIRST) 

SAME FOR 10**19 (4 WORDS) 



NOT TWOS COMPLEMENT! ! 



5 SAME FOR 10**36 (8 WORDS) 
OR EQUAL TO 10**37 BUT 8 WORDS LONG 



DCV: ; CONVERT INTEGER TO DECIMAL AT NEXT-TO-TOS 
; TOS MUST 3E A DECIMAL 
MOV (SP)»R0 
MOV SP,6K 
MOV 3K,R1 
TST (Rl)+ 



LENGTH IN RO 

DESTINATION POINTER FOR MOVE 

Rl IS 

SOURCE POINTER 



;g? 



3GS 





■WM 


(SP) t-(Sp) 


n: 


Ad\t 


(Rl)+f (Bk)+ 




soa 


RO.: 


61 




MOy/ 


nit i 


(BK) 




jvip 


3#BIGRTN 


SQROPS 


.E3U 


* 


**. 


16. 




BLT 


* 


+ 


4 




BLE 


* 


+ 


4 




3GE 


* 


+ 


4- 




B3T 


* 


+ 


4 




BNE 


* 


+ 


4 




3EQ 


* 


+ 


4 


UBROPS 


.EQU 


* 


_ 


16. 




BLO 


* 


+ 


4 




BLOS 


* 


+ 


4 




BHIS 


* 


+ 


4 




BHI 


* 


+ 


4 




BNE 


* 


+ 


4 




3E3 


* 


+ 


4- 



MOVE LENGTH 
MOVE DECIMAL 

LENGTH WORD FOR INTEGER 
EXIT DECOPS 



.END 



1 

2 
o 
4 
5 
6 
7 
3 
9 
10 
11 
12 
13 
14 
15 
16 
17 
18 
19 
20 
21 
22 
23 
24 
25 
26 
27 
28 
29 
30 
31 
32 
33 
34 
35 
36 
37 
33 
39 
40 
41 



I 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 



i:o 
i:c 

i:d 



i:o 

i:d 
i:j 
:d 
:d 
:o 
:d 
:d 
:d 
:d 
:d 
:d 
:o 
:d 
:d 
:o 
:d 
:d 
:o 
:o 



l 

l 

l 

l 

l 

i 

l 

l 

l 

l 

l 

l 

l 

l 

l 

l 

l 

i:d 

i:d 

i:o 

i:o 



:d 
:d 
:d 
:d 
:o 
:d 
:o 
:d 
:d 



i:d 
i:q 



i 
i 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 

3 
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(*$L PRIMER:*) 
PROGRAM CODESTAT; 

C 
I 

L 

: 

z 

L 

c 
c 
c 
c 
I 
z 
c 
c 
c 

CONST VERSIONs^II.O CA.SJ 1 ! 
MAXPROCNUM=15Q5 

TYPE NMENONIC=PACKED ARRAYC0..73 OF CHAR; 
3YTETYPE=ARRAYC0..7D OF INTEGER; 
WORDTYPE=ARRAYC0..153 OF INTEGER; 
3YTE=0..255; 

optype=( short* one, opt, two, lopt, words, chrstblk»cmprss,cmprss2, word); 
oprec=record case optype of 

short: (totalo: integer) 5 
one«chrs«blk: (totali: integer; 

byteonei:bytetype) ; 
two:{total2:integer; 

BYTE0NE2IBYTETYPE; 

bytetwo2:bytetype; 

FLAV0R2:ARRAYC2..29D OF INTEGER); 

word, opt: (totals: integer; 

parm0ne3:w0rdtype) ; 
lopt:(total4:integer; rr/- q 

BYTEOf :3YTETYPE; ^ 



370 



42 


1 


i:o 


J 


43 


1 


i: j 


5 


44 


1 


i:d 


6 


45 


i 


i:z 


5 


46 


1 


i:o 


5 


47 


1 


i:d 


3 


48 


1 


i:d 


3 


49 


1 


i:d 


3 


50 


1 


i:d 


3 


51 


1 


i:d 


3 


52 


1 


i:o 


3 


53 


1 


i:d 


3 


54 


1 


i:d 


3 


55 


1 


i:d 


3 


56 


1 


i:d 


3 


57 


1 


i:d 


3 


58 


1 


i:d 


3 


59 


1 


i:d 


3 


60 


1 


i:d 


3 


61 


1 


i:d 


3 


62 


1 


i:d 


3 


63 


1 


i:d 


3 


64 


1 


i:d 


3 


65 


1 


i:d 


3 


66 


1 


i:d 


3 


67 


1 


i:d 


3 


68 


1 


i:d 


3 


69 


1 


i:d 


3 


70 


1 


i:d 


4 


71 


1 


i:d 


6 


72 


1 


i:d 


15 


73 


1 


i:d 


16 


74 


1 


i:o 


17 


75 


1 


i:d 


17 


76 


1 


i:d 


24 


77 


1 


i:d 


24 


78 


1 


i:d 


24 


79 


1 


i:d 


24 


80 


1 


i:d 


44 


31 


1 


i:d 


45 


82 


1 


i:d 


47 



VAR 



INTEGER) ! 
OF INTEGER) 



PAR|WTinl04:ulORDTYPE) 5 
dORQS: (TOTALSUNTEGER! 

PARM0NE5:W0R0TYPE; 
PARMTW05:wGRDTYPEi 
PARMTHREE5IW0RDTYPE-) ; 

c^iPRss: (total6:integer; 

FLAVOR6:A'RRAYC0..tf0: OF 

cmprsss: (totaL7:integer; 

flav0r7iarrayc1..6d 

end; 

QpPTR=~OPREC; 
OPFACTS=RECORD 

NAMES:ARRAYCb2,.2553 OF NMENONIC; 

RECTYPES:ARRAYC0..2553 OF OPTYPE 

END 5 

jumprec=record 

pos.neg:wordtype 
end; 

prclarry=arrayc0..maxprocnum3 of integer; 
qsptr=~dsarry; 

dsarry=arrayc0..13 of integer? 
hextype=packed record case integer of 

0: (DUM2,DUMl,HltLO:0..15) 5 
i: (HIBYTE.LOWBYTE:0..255) ! 
2:(W0RD:INTEGER) 

END! 

display:boolean; 
chiCr:chari 

PC TMAX.MAXOP,lNUM,BYTESIZE.BYTEPOS, OP, BUFSTART.PROCNUV.SEGNUM: INTEGER; 
3ITE:BYTE; 

dsstart:dsptr; 

SWAP t CONTROL. CONSOLE tDONEPROC i LEXCHECKf DAT AWATCH* 

lexlook :boolean; 

hexcount.maxproc.segstblkibufstblktoptotal* 

segsize. offset. back jump, sldc. 

sldl.sldo.sind.procstart.dataseg.dataproc. 

datasegsize.lexlevel.dataref.dtsgsz, jumptotal : integer; 

hex:hextype; 

rnum:real; 

opcode :arr a ycc. 255 ^mf opptr; 



•j^r 



35 


1 


i:j 


a<+ 


1 


i:d 


as 


1 


i:o 


86 


1 


i:o 


87 


1 


i:o 


88 


1 


i:o 


89 


1 


i:d 


90 


1 


i:d 


91 


1 


i:d 


92 


1 


i:o 


93 


1 


i:d 


94 


1 


i:d 


95 


1 


i:d 


96 


1 


i:d 


97 


10 


i:d 


98 


10 


i:d 


99 


10 


i:d 


100 


10 


i:d 


101 


10 


i:d 


102 


10 


i:d 


103 


10 


i:d 


104 


10 


i:d 


105 


10 


i:d 


106 


10 


i:d 


107 


10 


2:d 


108 


10 


2:0 


109 


10 


2:1 


110 


10 


2:1 


111 


10 


2:1 


112 


10 


2:1 


113 


10 


2:1 


114 


10 


2:1 


115 


10 


2:1 


116 


10 


2:1 


117 


10 


2:1 


118 


10 


2:1 


119 


10 


2:1 


120 


10 


2:1 


121 


10 


2:1 


122 


10 


2:1 


123 


10 


2:2 



503 listfile:interactive; 

& c4 hexcharfcode tpacked arrayc 0. .153 of char; 

°20 inputfile:file; 

=60 jumpstats:jumprec; 

°92 seglex:arrayco..153 of integer; 

708 SEGDIRECrPACKEU ARRAYC0..5113 of byte; 

9 ^ NAMES!ARRAYC52..2553 OF NMENONIC; 

17 ^o rectypes:packed ARRAYC0..2553 of optype; 

is<^ procs:array co..maxprocnum3 of integer; 

15 ^5 proccall:arrayco. # 153 of ~prclarry; 

2gh jumps, proclexiarrayco. .993 of integer; 

2211 lastfilename;string; 

2252 bufferipacked arrayc .. 25593 of byte; 

3532 

1 segment procedure init! 

1 type rectifier=rec0rd case boolean of 

1 true:unt:integerj; 

1 false: (Rectype:optype> 

1 END? 

1 var iunteger; 

2 testtype:rectifier; 

3 filename:string; 

44 opfile:file of opfacts; 

1416 

1 procedure newop<flavor:optype) ; 

BEGIN 

case flavor of 

3 sh0rt:new(0pc0deci3. short) 5 

20 one:new(opcodeci3,one) ; 

37 8LK:NEW(0PC0DECI3,BLK) ; 

54 CHRS:NEW(0PC0DECI3»CHRS); 

71 OPT:NEW(OPCODECID,OPT) ; 

Q8 two:new(opcodecid,two) 5 

105 LOPT:NE^(OPcODECn,LOPT) ; 

122 WORDS: NEW (OPCODEC ID, WORDS) ; 

139 C>1PRSS:NEW(0PC0DECI3,CMPRSS) ; 

156 CMPRSS2:NEW(0PC0DECI3,CMPRSS2) ; 

173 W0R0:NEW(0PC0DECI3,W0RD) 

188 end; 

220 WITH OPCODECI3 A DO —~}A 

235 CASE FLAVOR OF ° ' * 



vJ 



72 



124 


lj 


2:2 


23d 


125 


1G 


2:2 


243 


126 


10 


2:1 


243 


127 


10 


2:4 


246 


128 


10 


2:3 


254 


129 


10 


2:2 


256 


130 


10 


2:4 


256 


131 


10 


2:4 


259 


132 


10 


2:4 


267 


133 


10 


2:4 


275 


134 


10 


2:3 


283 


135 


10 


2:2 


285 


136 


10 


2:4 


285 


137 


10 


2:4 


288 


138 


10 


2:3 


296 


139 


10 


2:2 


298 


110 


10 


2:4 


298 


i4i 


10 


2:4 


301 


142 


10 


2:4 


309 


143 


10 


2:3 


317 


144 


10 


2:2 


319 


145 


10 


2:4 


319 


146 


10 


2:4 


322 


147 


10 


2:4 


330 


148 


10 


2:4 


338 


149 


10 


2:3 


346 


150 


10 


2:2 


348 


151 


10 


2:4 


348 


152 


10 


2:4 


351 


153 


10 


2:3 


359 


154 


10 


2:2 


361 


155 


10 


2:4 


361 


156 


10 


2:4 


364 


157 


10 


2:3 


372 


158 


10 


2:2 


372 


159 


10 


2:0 


404 


160 


10 


2:0 


424 


161 


10 


1:0 





162 


10 


1:1 





163 


10 


1:1 


14 


164 


10 


1:1 


14 



end; 



sho;<t:totalo: = o; 

CHRStBLKiOUEItSE&IN 

totali:=o; 

FILLCHAR (3YTEONEl.l6t0) ; 

end; 
two:begin 

total2:=o; 

fillchar (byte0ne2.16.0) ; 
fillchar(bytetw02.16,0) ; 
fillchar<flavor2«56,0) ; 

END* 
WORDfOPKBEGlN 

totai_3:=o; 

fillchar{parmone3i32,0) j 
end; 
lopt:begin 

total4:=o; 
fillchar(byteone4*16«0) ; 

FILLCHAR(PARMTWO4.32t0); 

end; 
words:begin 

total5:=o; 
fillchar(parmone5»32,0) ; 

FlLLCHAR(PARMTW05t32»0) ; 

fillchar(parmthree5,32,0) j 
end; 
cmprss:3egin 

total6:=o; 

FlLLCHAR(FLAVOR6 t 82,0) * 

end; 
cmprss2:begin 

total7:=o; 

fillchar (flavor7. 12,0) * 

END 



END; 



BEGIN {* inIT *) 

cr:=chr(13) ; 
(*$I-*) 

RESEKOPFlLEt •OPCODES. II. 






165 


10 


i:i 


3o 


166 


10 


1:2 


42 


167 


10 


1:3 


42 


168 


10 


1:3 


63 


169 


10 


1:2 


92 


170 


10 


1:2 


92 


171 


10 


1:1 


92 


172 


10 


1:1 


100 


173 


10 


1:2 


116 


174 


10 


1:3 


116 


175 


10 


1:3 


132 


176 


10 


1:4 


152 


177 


10 


1:3 


166 


178 


10 


1:4 


174 


179 


10 


1:3 


190 


180 


10 


1:2 


204 


181 


10 


1:1 


211 


182 


10 


1:1 


219 


183 


10 


1:1 


229 


184 


10 


1:1 


234 


185 


10 


1:1 


305 


186 


10 


1:1 


310 


187 


10 


1:1 


339 


188 


10 


1:1 


358 


189 


10 


1:1 


358 


190 


10 


1:1 


397 


191 


10 


1:1 


397 


192 


10 


1:2 


403 


193 


10 


1:1 


415 


194 


10 


1:1 


439 


195 


10 


1:2 


453 


196 


10 


1:3 


484 


197 


10 


1:4 


484 


198 


10 


1:4 


498 


199 


13 


1:3 


515 


200 


10 


1:2 


515 


201 


10 


1:1 


535 


202 


10 


1:1 


545 


203 


10 


1:1 


550 


204 


10 


1:1 


620 


205 


10 


1:1 


699 



IF IOKESULTOO THEfj 
3EGIN 

wrlteln(»*0pc0des t i5 not on system disk*); 
exit(codestat) ; 
end; 
(*si+*) 

NAMES:=OPFlLE rt . NAMES! 
FOR i:=o TO 255 DO 
BEGIN 

NErtOPlOPFILE^.RECTYPESCn) ; 

IF 0RD(0PFILE A .RECTYPESCI])>255 THEN 

TESTTYPE.INT:=ORD(OPFlLE^.RECTYPESCID) MOD 256 

ELSE 

TESTTYPE.RECTYPE:=0PFILE A .RECTYPESCID5 

rectypesci3:=testtype.rectype; 
end; 

CLOSE(OPFILE); 
PAGE(OUTPUT) ; 
GOTOXY(22,10); 

WRITELNCUCSD P-CODE DISASSEMBLER », VERSION); 

GOTOXY(0«0); 

WRITE< 'INPUT CODE FILE: »); 

READLN(FILENAME) 5 

(*$I-*) 

OPENOLD(INPUTFILE f cONCAT(FlLENAME,*.CODE')); 
(*$I+*) 

IF IORESULT <> THEN 

OPEfgOLD(INPUTFlLEtFlLENAME) ; 
IF BL0CKREAD(INPUTFILE,SEGDIREC,1)=1 THEN ; 
FOR SEGNUM:=0 TO 15 DO 

IF SEGDIRECCSEGNUM*4D + SEGQIRECC SEGNUM*4 + l3<>0 THEN 
BEGIN 

NErttPROCCALLCSEGNUMj) ; 

FILLCHAR(PR0CCALLCSEGNUM3«,SI2E0F(PRCLARRY) , 0) ; 

END 

else proccallcsegnumd:=nil; 

PAGEfOUTPUT) ; 
GOTOXY(OtlO) ; 
writelmc *:iOt»lS this code file designed FOR A MACHINE'); 

SeIS^YBoIw^M BrTE ZER ° IS ™ E H0ST SIGNIFI " NT BYTE < LSI -" NO>,.„ 373 



37 



206 10 l:i 70 9 SWAP:=(cH= f Y f ) OR [CH='Y')i 

207 10 111 718 PAGE(OJTPUT) 5 
203 10 l:i 726 GOTOXY(0»10) ; 

209 10 i:i 735 WRITE( 'DIS-ASSEMBLY OUTPUT FILE (<CR> FOR NONE): •); 

210 10 111 737 READLN(FILENAME) 5 

211 io 1:1 806 lastfilename:=filename; 

212 10 111 313 display: = (fii_ename<>" ) ; 

213 10 i:i 322 console: = (filename= , console:«) OR (FILENAMES***!: 1 ); 

2m 10 1:1 850 IF DISPLAY THEN REWRITE (LISTFILE»FILENAME ) ; 

215 10 i:i 365 SEGNUM;=0; 

216 io 1:1 863 optotal:=o; 

217 10 l:i 871 sldc:=o; 

218 io 1:1 874 sldl:=o; 

219 10 111 877 sldo:=o; 

220 10 i:i 880 sind:=o; 

221 io 1:1 883 jumptotal:=o; 

222 10 ill 886 hexcount:=05 

223 10 i:i 889 CODE:=« *? 

224 10 111 913 HEXCHAR:=«0123H56789ABCDEF* ; 

225 10 i:i 937 FILLCHAR(JUMPSTATS.POS,32i0) ; 

226 10 i:i 945 FILLCHAR(JUMPSTATS.NEG»32«0) ; 

227 io 1:1 953 lexlook:=falsej 

228 10 1:0 956 END; 

229 10 110 978 

230 1 2:D 1 PROCEDURE PROMPT; FORWARD; 

231 1 2ID 1 

232 11 i:D 1 SEGMENT PROCEDURE DISASSEMBLE; 

233 11 i:d 1 

234 11 2:D 3 FUNCTION 3UFRESET (BYTEPOS, OFFSET, DIRECTION: INTEGER) : INTEGER ; 

235 11 2:0 6 VAR NEWBYTE: INTEGER ? 

236 11 2:0 BEGIN 

237 11 2:i NEWBYTe:=BYTEPOS + OFFSET; 

238 11 2U 5 REPEAT 

239 11 2:2 5 BUFSTBLK:=BUFSTBLK + DIRECTION? 

240 11 2:2 11 BUFSTART:=(BUFSTBLK - SEGST3LK)*512; 

241 11 2:1 22 UNTIL (NEWBYTE - 3UFSTART>=0) AND (NEWBYTE - BUFSTART<2557 ) ; 

242 11 2:i 37 IF BL0CKREAD(INPUTFILE, BUFFER, 5»3UFSTBLK)=1 THEN; 

243 11 2:1 59 BUFRESET:=NEWBYTE - BUFSTART; 

244 11 2:0 64 END! 

245 11 2:0 78 

246 11 3:D 3 FUNCTION LASTBYTE : BYTE J 



247 


11 


3:d 


3 


246 


11 


3:o 





24y 


11 


3:1 





250 


11 


3:2 


5 


251 


11 


3:3 


5 


252 


11 


3:3 


13 


253 


11 


3:2 


24 


254 


11 


3:1 


24 


255 


11 


3:2 


26 


256 


11 


3:3 


26 


257 


11 


3:3 


31 


258 


11 


3:2 


37 


259 


11 


3:i 


37 


260 


11 


3:o 


54 


261 


11 


3:o 


66 


262 


11 


<+:d 


3 


263 


11 


4:d 


3 


264 


11 


4:o 





265 


11 


*»:i 





266 


11 


4:2 


7 


267 


11 


4:1 


18 


268 


11 


<*:i 


35 


269 


11 


f:2 


41 


270 


11 


<K3 


41 


271 


11 


f:3 


61 


272 


11 


4:3 


82 


273 


11 


4:3 


105 


274 


11 


4:2 


111 


275 


11 


4:1 


111 


276 


11 


4:0 


116 


277 


11 


4:0 


128 


278 


11 


5:d 


3 


279 


11 


5:d 


3 


280 


11 


5:d 


4 


281 


11 


s:o 





282 


11 


5:i 





283 


11 


5:i 


11 


284 


11 


5:2 


lb 


285 


11 


5:3 


16 


286 


11 


5:3 


30 


287 


11 


5:3 


45 



VAR CHANGE: INTEGER; 
BEGIN 

IF BYTrpOS<l THEN 
BEGIN 

3YTEP0S:=3UFRESET(BUFSTART + BYTEPOS . -1 . -1 ) ; 

offset:=offset - l; 

END 
ELSE 

BEGIN 

3Ytepos:=bytepos - 15 
offset:=offset - i; 

end; 

lastbyte:=buffercbytepos3; 

end; 

function getbyte:byte; 
var hex:hextype; 

BEGIN 

if bytep0s>2559 then 

bytep0s:=bufreset(bufstart + bytepos,0»5) ; 
getbyte:=buffercbytepos3; 
if hexc0unt<15 then 

BEGIN 

hex.lowbyte:=buffercbyteposd; 
coqechexcountd:shexcharchex.hi3j 
coqechexcount + 1 31 =hexcharchex.lo] ; 
hexcount:=hexcount + 2; 
end; 
bytepos:=bytepos + 11 
end; 

function getbig:integer; 
var big;hextype? 
firstbyte:byte; 

begin 

first3yte:=getbyte; 
if firstbyte>127 then 

BEGIN 

big.lo^byte:=getbyte; 

big.hibyte:=firstbyte - 128; ^7^ 

getbig:=big.word; ° 



O t t) 



233 


11 


5:2 


45 


L l'\i D 


289 


11 


5:i 


48 


ELSE GETBIG:=FIRSTBYTE; 


290 


11 


s:o 


53 


end; 


291 


11 


5:o 


66 




292 


11 


6:d 


3 


FUNCTION GETdQRD: INTEGER; 


293 


11 


6:d 


3 


var weRj:hextype; 


294 


11 


&:o 





BEGIN 


295 


11 


6:i 





IF SWAP THEN 


296 


11 


6:2 


4 


BEGIN 


297 


11 


6:3 


4 


werq.hibyte:=getbyte; 


298 


11 


6:3 


18 


werd.lowbyte:=getbytej 


299 


11 


6:2 


32 


END 


300 


11 


6:i 


32 


ELSE 


301 


11 


6:2 


34 


begin 


302 


11 


6:3 


34 


werd.lowbyte:=getbyte; 


303 


11 


6:3 


48 


werd.hibyte:=getbyte; 


304 


11 


6:2 


62 


end; 


305 


11 


6:i 


62 


getword:=werd.word; 


306 


11 


6:o 


65 


end; 


307 


11 


6:o 


78 




308 


11 


7:d 


3 


function mostsigbit<operand:integer> :integer; 


309 


11 


7:d 


4 


var bytesize:integer; 


310 


11 


7:o 





begin 


311 


11 


7:1 





if operand<o then 


312 


11 


7:2 


5 


mostsigbit:=15 


313 


11 


7:1 


5 


ELSE 


314 


11 


7:2 


10 


begin 


315 


11 


7:3 


10 


bytesize:=-i; 


316 


11 


7:3 


14 


REPEAT 


317 


11 


7:4 


14 


bytesize:=bytesize + 1; 


318 


11 


7:4 


19 


operand:=operand oiv 2; 


319 


11 


7:3 


24 


until operand=o; 


320 


11 


7:3 


29 


mostsigbit:=bytesize; 


321 


11 


7:2 


32 


end; 


322 


11 


7:0 


32 


end; 


323 


11 


7:0 


46 




324 


11 


8:d 


1 


procedure actaccess(finalex,offset:integer); forward; 


325 


11 


8:d 


3 




326 


11 


9:d 


1 


procedure shortop; 


327 


11 


9:0 


1 


CSLDC ABI A3R ADI ADR LAND DIF DVl DVR CHK FLO FLT INN INT 


328 


11 


9:d 


1 


LOR modi mpi hpr ngi nq% lnot srs sbi sbr sgs sqi sqr sto 



tit J J l' D 1 IXS UNI S2P LDCN LUP STP LD3 STB EQUI GEQI GTRI LEQI LESI NEQI 

330 1:L 9 ^ 1 SIP 1X3 BYT XIT SLOL SLDO SIND3 

331 11 9:C 1 

332 11 9:0 BEGIN 

3 ? 3 11 9:1 OPCODECBITE3*.TOTALO:=OPCOOEC3ITE3*.TOTALO + 1; 

55l + 1X 9 «1 26 IF BITE=2m THEN DONEPRoC :=TRUE; 

335 11 9 =1 3d IF BITE<128 THEN 

336 11 9:2 43 BEGIN 

337 11 9:3 43 SLOC:=SLDC + 1; 

1*1 ^ HI * 3 IF DISPLAY THEN WRITELN ( LISTFILE, NAMESC127 J, BITE:6, • »:i8.C0DE)J 

339 11 9:2 116 END 

340 11 9:1 H6 ELSE 

341 11 9:2 118 BEGIN 

342 11 9:3 118 IF DISPLAY THEN WRITE (LISTFILE .NAMESCBITE 1) 5 

343 11 9:3 144 IF BlTE>215 THEN 

344 11 9:4 151 IF BITE<232 THEN 

345 11 9:5 158 BEGIN 

346 11 9:6 158 SLDL:=SLDL + 1* 

111 J J V S 164 IF DATA WATCH THEN ACTACCESS (LEXLEVEL, BITE - 215); 

3^9 11 9'5 225 IF DISF>LAY ™ EN WrIt ^-N{ LISTFILE, BITE-215:6, ♦ •:18,C0DE)| 

350 11 9:4 225 ELSE IF BITE<248 THEN 

351 11 9:6 234 BEGIN 

352 11 9:7 234 SLDO:=SLDO + II 

353 11 9:7 240 IF DATAWATCH THEN ACTACCESS( ,8ITE - 231); 

lit II VI 252 IF DISPLAY TH E N WRITELN(LISTFILE,BITE-23i:6,» »:18,C0DE); 

33b 11 9:6 300 END 

356 11 9:5 300 ELSE 

357 11 9:6 302 BEGIN 

358 11 9:7 302 SIND:=SI!\|D + 1; 

HI " l 17 308 IF DISPLAY THEN WRITELN (LISTFILE, BlTE-248:6, • •:18iC0DE)| 

360 11 9:6 356 END 

361 11 9:3 356 ELSE 

362 11 9:4 358 IF DISPLAY THEN WRITELN(LISTFILE, • «:24,CODE)5 

363 11 9:2 392 end; 

364 11 9:i 392 IF DONEPROC THEN 

365 11 9:2 396 IF DISPLAY THEN fcRITELN (LISTFILE ) ; 

366 11 9:o 407 END; 

367 11 9:0 426 

368 11 10:D 1 PROCEDURE ONEOP; 

369 11 '.0:0 1 cADJ FJP SAS RNP ClP UJP DM STM RBP CBP CLP CGP EFJ NFJ3 ^77 



J < 5 



370 


11 


io :d 


1 


371 


11 


io :u 


1 


372 


11 


io:o 


2 


373 


11 


io:d 


3 


371 


11 


h:d 


1 


375 


11 


n :d 


1 


376 


11 


n:o 





377 


11 


11:1 





378 


11 


11:1 


7 


379 


11 


11:1 


17 


380 


11 


11:1 


21 


381 


11 


11:2 


21 


382 


11 


11:2 


26 


383 


11 


11:1 


31 


381 


11 


11:1 


41 


385 


11 


11:2 


41 


386 


11 


11:1 


63 


387 


11 


11:2 


66 


388 


11 


11:0 


90 


389 


11 


11:0 


101 


390 


11 


10:0 





391 


11 


10:1 





392 


11 


10:2 


13 


393 


11 


10:3 


13 


391 


11 


10:3 


19 


395 


11 


10:3 


15 


396 


11 


10:3 


61 


397 


11 


10:4 


81 


398 


11 


10:5 


81 


399 


11 


10:5 


95 


too 


11 


10:6 


102 


401 


11 


10:7 


102 


102 


11 


10:7 


108 


403 


11 


10:7 


111 


404 


11 


10:7 


113 


405 


11 


10:8 


116 


406 


11 


10:6 


161 


407 


11 


10:5 


161 


408 


11 


10:6 


166 


409 


11 


10:7 


166 


410 


11 


10:7 


172 



van juv,psize:integer; 

PCaLL: BOOLEAN; 

procedure jumpopst; 
var neg: boolean; 

BEGIN 

NEG:=(juMP3IZE<0) ; 

if neg then jumpsize :=- jumpsize ; 
6YTesize:=-i; 

REPEAT 

bytesize:=bytesize + 15 

jumpsize:=jumpsize div 2; 
until jumpsize=o; 
if neg then 

jumpstats.negcbytesize3:=ju«ipstats.negcbyteslzea + 1 

ELSE 

JUMPSTATS.P0SCBYTESIZE3:=JUMPSTATS.P0SCBYTESIZE3 + l; 

END? 

BEGIN(* ONEOP *) 

WITH OPCODECBITE3* DO 
BEGIN 

TOTALl:=TOTALl + 1; 

IF DISPLAY THEN WRITE ( LISTFILEiNAMESCBITED) ! 
IF (BITE=173) OR (BITE=193) THEN DONEPROC :=TRUE ? 
IF (BITE IN C161»185»211.2123) THEN 
3EGIN 

bite:=getbyte; 

IF BITE<128 THEN 
BEGIN 

jumptotal:=jumptotal + 1; 

jumpsize:=bite; 

jumpopst; 

if display then writeln (listfile » 

5UFSTART + 3YTEP0S + BITE - PR0CSTARTI6. * »:18iC0DE); 

END 
ELSE 
BEGIN 

jumptotal:=jumptotal + is 

JUMPSlzE:=JUMPSr (256-BITE-8)DIV 23 - ( BUFSTART+BYTEPOS-P^CSTART) 



\P3L (256-BITE-8)DIV 23 - ( BUFSTART+BYTEPOS-PBAC! 



411 


11 


io:7 


199 


412 


11 


io:7 


201 


413 


11 


io:8 


204 


414 


11 


io:6 


262 


415 


11 


io:4 


262 


416 


11 


io:3 


262 


417 


11 


io:4 


264 


418 


11 


10:5 


264 


419 


11 


10:5 


282 


420 


11 


10:5 


293 


421 


11 


10:6 


296 


422 


11 


10:5 


336 


423 


11 


10:5 


380 


424 


11 


10:6 


384 


425 


11 


10:4 


395 


426 


11 


10:3 


395 


427 


11 


10:3 


402 


428 


11 


10:2 


424 


429 


11 


10:0 


424 


430 


11 


10:0 


440 


431 


11 


12:0 


1 


432 


11 


12 :d 


1 


433 


11 


12 :d 


1 


434 


11 


12:0 


2 


435 


11 


12:0 





436 


11 


12:1 





437 


11 


12:2 


13 


438 


11 


12:3 


13 


439 


11 


12:3 


19 


440 


11 


12:4 


23 


441 


11 


12:5 


23 


442 


11 


12:5 


41 


443 


11 


12:4 


59 


444 


11 


12:3 


59 


445 


11 


12:3 


85 


446 


11 


12:3 


91 


447 


11 


12:3 


93 


448 


11 


12:3 


120 


449 


11 


12:4 


124 


450 


11 


12:4 


130 


451 


11 


, 2:3 


141 



jumpopst; 

IF DISPLAY THEN WRITELN < LISTFILE . 

JUVIPSC(256 - BITE - 8) DIV 23:6,' •:i8.C0DEM 

END 
ELSE 
BEGIN 

pcall: = (bite in ci7«+,206.207:n ; 

BITE:=GETBYTE; 
IF PCALL THEN 

PROCCALLCSEGNUM3*CBITE3:=PROCCALLCSEGNUM3*CBITE3 + 1; 
IF DISPLAY THEN WRITELN ( LISTFILE.BITE:6. » »:18,C0DE)S 
IF DONEPROC THEN 

IF DISPLAY THEN WRITELN(LISTFILE ) ; 

end; 
bytesize;=mostsigbit(bite> ! 

BYTE0NE1CBYTESI2E3:=BYTE0NE1CBYTESIZED + 1: 
END? 
END? 

PROCEDURE OPTOPJ 

CINC IND IXA LAO LDO MOV WB SRO LLA LDL STL BTP3 

VAR BIG:INTEGER? j 

LOCAL* GLOBAL: BOOLEAN! 

BEGIN 

WITH 0PC0DECBITED A DO 
BEGIN 

T0TAL3:=T0TAL3 + 15 
IF OATAWATCH THEN 
BEGIN 

LOCAL:=(BlTE IN C198«202.204D); 
GLOBAL:=(BITE IN C165.167.1713); 
END? 

IF DISPLAY THEN WRITE (LISTFILE.NAMESCBITE3) ? 

big:=getbig? 
bytesi2e:=mostsigbit(BIG); 

PARM0NE3CBYTESIZE3:=PARM0NE3CBYTESIZED + 1; 
IF DATAWATCH THEN 

IF LOCAL THEN ACTACCESS ( LEXLEVEL,BIG ) 

ELSE IF GLOBAL THEN ACTACCESS ( ,BIG) ; _^ 

IF DISPLAY THEN WRITELN/ ~STFILE.BIG:6, » f :18,C0DE)? ° ' 9 



580 



452 11 1212 135 end; 

453 11 12:0 185 ENDS 
454- 11 12:0 198 

155 11 13:D 1 PROCEDURE LOPTOP; 

456 11 13ID 1 CLDA LOD STRH 

457 11 13:D 1 VAR Bl3fLlNKS:iNTEGERS 

458 11 13:0 BEGIN 

459 11 13:1 WITH OPCODECBITED^ DO 

460 11 1312 13 BEGIN 

461 11 13:3 13 T0TAL4:=T0TAL4 + 1; 

462 11 13:3 19 IF DISPLAY THEN WRITE ( LISTFILE.NAMESCBITE3) ! 

463 11 13:3 45 BlTE : =GETBYTE ? 

464 11 1313 56 IF DISPLAY THEN WRITE ( LISTFILEtBITE: 6 ) ; 

465 11 13:3 69 LlNKS:=BITE; 

466 11 13:3 72 bytesize : =mostslgbit(bite) ; 

467 11 13:3 79 byte0ne4cbytesized;=byte0ne4cbytesized + 1; 

468 11 13:3 101 big:=getbig; 

469 11 13:3 107 bytesize:=m0stsigb!t(big) ; 

470 11 13:3 114 parmtw04cbytesize3:=parmtw04cbytesize: + li 

471 11 13:3 136 if datawatch then actaccess ( lexlevel - linkstbig); 

472 11 13:3 147 if display then> writeln ( listfile.big :6, • »:l2tc0de)j 

473 11 13:2 191 END? 

474 11 13:0 191 end; 

475 11 13:0 204 

476 11 14:0 1 PROCEDURE TWOOP; 

477 11 14:0 1 CIXP CXP3 

478 11 14:d 1 var byteone»bytetwo:byte ! 

479 11 14:d 3 extpr:boolean; 

480 11 14:0 BEGIN 

481 11 14:1 WITH OpcODECBITED* DO 

482 11 14!2 13 BEGIN 

483 11 14:3 13 t0tal2:=t0tal2+ u 

484 11 14:3 19 if display then wrlte(listfilefnamesebited) i 

485 11 14:3 45 if blte=205 then extpr:=true else extpr :=false? 

486 11 14:3 60 byteone:=getbyte; 

487 11 14:3 71 bytesize:=m0stsigbit(byte0ne) ; 

488 11 14:3 78 byte0ne2cbytesize 1 : =byteone2c bytesize 1 + 1; 

489 11 14:3 100 bytetwo:=getbyte; 

490 11 14:3 111 d0nepr0c:=(extpr) and (byteone=0> and (bytetw0=2>; 

491 11 14:3 122 if (extpr) and (byteone=0) and (bytetw0>1) and (bytetwo<30) then 

492 11 14:4 137 3-GIN 



493 


11 


14:5 


137 


494 


11 


14:5 


163 


495 


11 


14:4 


222 


496 


11 


14:3 


222 


497 


11 


14:4 


224 


498 


11 


14:5 


224 


499 


11 


14:6 


227 


500 


11 


14:5 


267 


501 


11 


14:4 


321 


502 


11 


14:3 


321 


503 


11 


14:3 


328 


504 


11 


14:2 


350 


505 


11 


i4:o 


350 


506 


11 


14:0 


362 


507 


11 


i4:o 


362 


508 


11 


15:0 


1 


509 


11 


15:d 


1 


510 


11 


15:d 


1 


511 


11 


15:0 





512 


11 


I5:i 





513 


11 


15:2 


13 


514 


11 


15:3 


13 


515 


11 


15:3 


19 


516 


11 


15:3 


45 


517 


11 


15:3 


51 


518 


11 


15:3 


95 


519 


11 


15:3 


102 


520 


11 


15:2 


124 


521 


11 


i5:o 


124 


522 


11 


i5:o 


136 


523 


11 


16 :d 


1 


524 


11 


16:d 


1 


525 


11 


16:d 


1 


526 


11 


i6:o 





527 


11 


i6:i 





528 


11 


16:2 


13 


529 


11 


16: 3 


13 


530 


11 


16:3 


19 


531 


11 


16:3 


45 


532 


11 


16:3 


59 


533 


11 


'.6:3 


65 



FLAVOR2CBYTETlm03:=FLAVOR2CEYTETW03 + li 

IF DISPLAY THEN WRITELN ( LISTFlLE . NAMESC 56 + BYTETW03,» *:16.C0DE)I 
END 
ELSE 
3EGIN 

IF EXTPR THEN 

PROCCALLCBYTEONE3 a I:3YTETWOD:=PROCCALL[:BYTEONE3 a CBYTETW03 ♦ 11 
IF DISPLAY THEM WRITELN ( LISTFILE»BYTE0NE:6,BYTETW0:6, ♦ »:i2»CODE); 

END! 

bytesize:=mostsigbit(bytetwo) ; 

BYTETW02CBYTESI2E3:=BYTETW02CBYTESIZE3 + 1; 

end; 

end; 

procedure wordop; 

C LCI 3 

var werd:inteser; 

begin 

with OPCODECBITEJ^ do 
BEGIN 

T0TAL3:=T0TAL3+ II 

IF DISPLAY THEN WRITEUISTFILEtNAMESCBITE}) ; 

werd:=getword; 

IF DISPLAY THEN WRITELN(LISTFILE. WERDI6, • »:18,C0DE)I 

bytesize:=mostsigbit(werd) i 

parm0ne3cbytesize3:=parm0ne3cbytesize3 + 1| 
end; 
end; 

procedure wordsopl 
c xjp : 

VAR WORDltWORD2tWORD3:iNTEGER5 
BEGIN 

WITH OPCODECBITE3* DO 

BEGIN 

t0tal5:=t0tal5 + 1; 

if display then write ( listflle* namescbite3) i 

if odd(bytepos) then bite: =getbyte; 

wordi:=getword; ^ 

BYTESlZE:=M0STSlGBlT(W0p ); ->c51 



582 



534 11 16:3 72 PA3y0ijE5CBYTESlZt:i:=PARM0NEbC3YTt.SIZLD + 1; 

535 li 16:3 *4 W0*D2:=SET*0Rus 

536 11 1613 1CD 3YrtSl2i::=W0STSlSBir(W0RD2) ; 

537 11 16:3 137 PAR;^TW05CBYTESlZt3:=PARMTW05CBYTESlZED + 1; 
533 11 16:3 12? 8YTESIZE:=M0STSIGBIT(W0RD2-W0RD1+1) ; 

539 11 16:3 140 PArmTHREE5CBYTESIZE}:=PaRMTHREE5CBYTESIZED + n 

540 11 16:3 162 3lTE:=GET3YTE; BITE : =GETBYTE ; 

541 11 16:3 134 IF 3ITE<123 THEN 

542 11 16:4 191 woRD3:=BUFSTART + BYTEPOS + BITE - PROCSTART 

543 11 16:3 196 ELSE 

544 11 16!4 2Q3 ^QRD3 : =JUMPSC ( 256 - BITE - 8) DIV 2D; 

545 11 16:3 223 IF DISPLAY THEN WRITELN ( LlSTFILEi W0RD1 :6, W0RD2 :6» W0RD3: 6* * *:6,C0DE); 

546 11 16:3 287 W0RD2:=W0RD2 - W0RD1 + II 

547 11 16!3 294 FOR WORDi:=l TO W0RD2 DO 

548 11 16:4 305 3EGIN 

549 11 16:5 305 hexcount:=o; 

550 11 1615 306 cqde:=* •; 

551 11 16:5 332 W0RD3:=GETW0RD I 

552 11 16:5 333 W0R03 : =BUFSTART + BYTEPOS - WORD3 - 2 - PROCSTART; 

553 11 16:5 350 IF DISPLAY THEN WRITELN ( LISTFlLE » W0RD3: 41 , • , :18«C0DE>{ 

554 11 16:4 394 END! 

555 11 16!2 401 end; 

556 11 16:0 401 end; 

557 11 16:0 416 

558 11 17!D 1 PROCEDURE CMPRSSOP! 

559 11 17:0 1 z CSP 2 

560 11 17:0 BEGIN 

561 11 17Z1 WITH OPcODECBITE]* DO 

562 11 17:2 13 BEGIN 

563 11 17:3 13 T0TAL6.*=T0TAL6 + 1; 

564 11 17:3 19 IF DISPLAY THEN WRITE< LISTFlLE t NAMESCBITED ) I 

565 11 17:3 45 bite:=getbyte; 

566 11 17:3 56 IF DISPLAY THEN WRITELN(LISTFILE»NAMESC86 + BITED,' »:16,C0DE); 

567 11 17:3 115 FLAV0R6CBITED:=FLAV0R6CBITE: + II 

568 11 17!2 137 END? 

569 11 17:0 137 end; 

570 11 17:0 150 

571 11 17:0 150 

572 11 18:D 1 PROCEDURE CWPRSS20P; 

573 11 18:D 1 CEQU GE3 GTR LEQ LES NEQD 

574 11 18:D 1 \/AR Bl3:INTEGER; 



575 

576 

577 

578 

579 

580 

581 

582 

583 

584 

585 

586 

587 

588 

589 

590 

591 

592 

593 

594 

595 

596 

597 

593 

599 

600 

601 

602 

603 

604 

605 

606 

607 

608 

609 

61Q 

611 

612 

613 

614 

615 



11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 

11 



18 
18 
18 
18 
18 
18 
18 
18 
18 

18:*+ 
18:4 
ie:4 
18:4 
18:4 
18:4 
18:4 
18:4 
18:2 
ie:o 
i8:o 
19:d 
19:d 
19:d 
19:o 
i9:i 
19:2 



19:3 
19:3 
19:3 
19:3 
19: 3 
19:3 
19:3 
19:4 
19:3 
19:4 
19:3 
19:2 
19:0 
19:0 
T9:o 




13 
13 
19 
45 
56 
86 
101 
104 
107 
156 
205 
254 
303 
362 
419 
450 
450 
468 
1 
1 
1 


13 
13 
19 
45 
56 
85 
92 
114 
117 
141 
150 
174 
195 
195 
212 
212 



BEGIN 

WITH 0PC0DEC3ITED" DO 
BEGIN 

t0tal7:=t0tal7 
if display the 
bite:=getbyte; 
flav0r7c6ite d 

IF (3ITE=10) 

IF DISPLAY THE 

CASE BITE OF 

2:WRITEL,M 

4:WRITELN 

6:WRITELN 

8:WRITELN 

10:WRITELN 

12IWRITELN 

END! 

end; 
end; 



+ l; 

N WRITEUISTFILE.NAMESCBITE}) 5 

IV 2D:=FLAV0R7CBITE DIV 23 +15 
R (BITE=12) THEN 3IG;=GETBIG; 

N 



(LISTFILE, »REAL' 
(LISTFILE»»STR • 
(LISTFILE, 'BOOL' 
(LISTFILE, »POWR» 
(LISTFILE, »3YTE* 
(LISTFILE, •WORD* 



*:20tCODE) ; 

' :20.coDE) ; 



• »:20iCODE){ 
» *:2QiC0DE); 
BIG:6«* »:14«C0DE); 
3IG:6f» »:14»C0DE) 



PROCEDURE CHRSOP! 

C LCA 3 

VAR SKlPOVER,i:iNTEGER! 

BEGIN 

WITH OPCODECBITE3* do 
3EGIN 

TOTALl:=TOTALl + 1; 

IF DISPLAY THEN WRITE (LISTFILE, NAMESCBITE3) ; 

BITE:=GETBYTE; 

IF DISPLAY THEN WRITE(LISTFILE.3ITE:6, » »»•); 

BYTESIZE:=M0STSIGBIT(BITE) ; 

BYTE0NE1CBYTESIZED:=BYTE0NE1CBYTESI2E3 + n 

IF DISPLAY THEN 

FOR l:=l TO BITE DO WRITE ( LISTFILE iCHR (GETBYTE) ) 
ELSE 

for i:=l to bite do skipover :=getbyte 5 
if display then writeln (listfile* "•') ; 

end; 
end; 
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34 
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11 


2 c : o 


1 


617 


11 


2Q:o 


1 


618 


11 


2o:d 


1 


619 


11 


20:0 





620 


11 


20:1 





621 


11 


20:2 


13 


622 


11 


20:3 


13 


623 


11 


20:3 


1? 


624 


11 


20:3 


45 


625 


li 


20:3 


56 


626 


11 


20:3 


100 


627 


11 


20:3 


107 


628 


11 


20:3 


129 


629 


11 


20:3 


138 


630 


11 


20:4 


149 


631 


11 


20:5 


149 


632 


11 


20:5 


152 


633 


11 


20:5 


176 


634 


11 


20:5 


182 


635 


11 


20:4 


226 


636 


11 


20:2 


233 


637 


11 


20:0 


233 


638 


11 


20:0 


243 


633 


11 


20:0 


248 


639 


11 


20:0 


248 


640 


11 


20:0 


248 


641 


11 


20:0 


248 


642 


11 


2i:d 


1 


643 


11 


2i:d 


1 


644 


11 


21:0 


2 


645 


11 


2i:d 


4 


646 


11 


22:0 


1 


647 


11 


22:d 


1 


648 


11 


22:0 





649 


11 


22:1 





650 


11 


22:1 


14 


651 


11 


22:2 


14 


652 


11 


22:2 


20 


653 


11 


22:2 


26 


654 


11 


22:2 


37 


655 


11 


22:3 


41 



PROCEDURE 3LK0P; 

l LDC : 

VAR WERD,IiSKIPOVER:INTEGER? 

-,EGIM 

WITH opcodecbite:^ DO 

BEGIN 

TOTALi:=TOTAI_l + 1; 

if display then write ( listfile « namesc3ite 3 ) 5 

bite:=getbyte; 

ip display then writeln ( listfile »bite : 6 ♦ • »:18»c0dem 

bytesi2e:=m0stsigbit(bite) ; 

byte0ne1cbytesize3:=byte0ne1cbytesized + 15 

if qdd(bytepos) then skipover: =getbyte ; 

FOR I!=l TO BITE DO 
BEGIN 

hexcount:=o; 

COOE:=» ♦; 

weRd:=getword; 

if display then writeln ( listfile , werdi41 , » »:18,c0de); 

END; 
end; 
end; 

(**I DlSftSMl.TEXT *) 

CSTART OF DISASMl.TEXTD 
CCOPYRIGHT (C) REGENTS OF UNIVERSITY OF CALIFORNIA AT SAN DIEGOD 

PROCEDURE procejur; 
var hex:hextype; 

l 1 nenum,lprocnum: integer; 

procedure jumpinfo; 
var otherbyteiintegerj 

BEGIN 

BACKJUmp:=0! BYTEPOS:=BYTEPOS - 6; OFFSET: =OFFSET - 6; 
REPEAT 

backjump.*=backjump + 1! 

otherbyte:=lastbyte; 

bite:=lastbyte; 

if swap then cjumps relative to start of segments 

JUhpSCBACKJUMP:j:=BUFS"MT + 3YTEP0S - BITE*256 - OTHERBYTE 



656 


11 


22:2 


oG 


657 


11 


22:3 


65 


65a 


11 


22:4 


65 


659 


11 


22:4 


87 


660 


11 


22:3 


95 


661 


11 


22:i 


95 


662 


11 


22:1 


105 


663 


11 


22:1 


119 


664 


11 


22:2 


127 


665 


11 


22U 


135 


666 


11 


22:2 


143 


667 


11 


22:i 


149 


668 


11 


22:i 


154 


669 


11 


22:2 


175 


670 


11 


22:0 


208 


671 


11 


22:0 


224 


672 


11 


21:0 





673 


11 


2l:i 





674 


11 


21:2 


16 


675 


11 


2l:i 


57 


676 


11 


21:2 


59 


677 


11 


21:3 


59 


678 


11 


21:3 


86 


679 


11 


21:4 


91 


660 


11 


21:3 


116 


681 


11 


21:5 


131 


682 


11 


21:3 


142 


683 


11 


21:3 


148 


681 


11 


21:3 


154 


685 


11 


21.'3 


160 


666 


11 


21:3 


165 


687 


11 


21:3 


177 


688 


11 


21:4 


185 


689 


11 


21:5 


190 


690 


11 


21:4 


266 


691 


11 


21:5 


268 


692 


11 


2126 


268 


693 


11 


21:6 


270 


694 


11 


21:6 


273 


695 


11 


21:7 


276 


696 


11 


u:7 


322 



ELSE 

BE3IN 

JU«IPSCBACKJU,V|P3:=3UFSTART + BYTEPOS - BITE - 0THERBYTE*256 5 
3ITE:=0THERBYTE; 

end; 

UNTIL (BITE>127) OR ( BACKJUMP=99 ) J 

JUMPSC03:=BACKJUMP - 1; 

IF BYTEPOS - OFFSET<0 THEN 

BYTEPOS:=BUFRESET(BUFSTART + BYTEPOS , -OFFSET, -1 ) 
ELSE 

BYTEPOS:=BYTEPOS - OFFSET; 
PROCSTART:=BUFSTART + BYTEPOS; CJUMPS NOW RELATIVE TO START OF PROCEDURES 
FOR 3ACKJUMP:=1 TO JUMPSC03 DO 

JUMPSCBACKJUMP3: = JUMPSCBACKJUMPD - PROCSTART; 

end; 

begin (*pr0cejur*) 
if procscprocnum3=0 then 
writeln(»procedure not in file') 

ELSE 

BEGIN 

BYTEP0S:=SEGSIZE - BUFSTART - 2*(PROCNUM + 1) - PROCSCPROCNUM3 - 21 
IF BYTEPOS<0 THEN 

BYTEPOSI=BUFRESET(SEGSIZE - 2*<PR0CNUM + 1) ,-PROCSCPROCNUMD - 2,-1) 

else if bytep0s>2556 then 

bytepos:=bufreset{bufstart + bytepos, f 1 ) 5 
offset:=getword; c pointer to enter ic i 

lprocnum:=getbyte; 
lexlevel:=getbyte; 
bytepos:=bytepos - 4; 
if lexlevel=255 then lexlevel:=-1 ; 
if not (lexcheck or lexlook) then 

if lprocnum=0 then 
writelnt 'procedure ' ,procnum: 3, • is written in assembly.') 

ELSE 
3EGIN 

JUMPINFO; 

DONEPROC:=FALSE; 

IF DISPLAY THEN WRITELN(LISTFILE » 

' »:iO»'BLOCK #', BYTEPOS DIV 512 + BUFSTBLK:3, rrotr 

OFFSET 7 3L0CK=', BYTEPOS MOD 512:3, CR, J °° 



•— f-> r? 
JoD 
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11 


21:7 
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698 


11 


2i:6 


4 b 5 


699 
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21:7 
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700 


11 


21:7 


502 


701 


11 


21:6 


514 


702 


11 


21:6 


517 


703 


11 


21:7 


517 


704 


11 


21:7 


525 


705 


11 


21:8 


568 


706 


11 


21:7 


643 


707 


11 


21:8 


656 


703 


11 


21:9 


656 


709 


11 


21:9 


666 


710 


11 


21:9 


671 


711 


11 


2i:a 


704 


712 


11 


21:7 


704 


713 


11 


21:7 


707 


7m 


11 


21:7 


731 


715 


11 


21:7 


742 


716 


11 


21:7 


748 


717 


11 


21:7 


763 


718 


11 


21:7 


767 
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11 


21:7 


771 


720 


11 


21:7 


775 
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11 


21:7 


779 


722 


11 


21:7 


783 
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11 


21:7 
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11 


21:7 


791 


725 


11 


21:7 


795 


726 


11 


21:7 


799 


727 


11 


21:7 


803 
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11 


21:7 
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11 


21:6 


836 


730 


11 


21:5 


840 


731 


11 


21:2 


840 


732 


11 


21:0 


840 


733 


11 


21:0 


862 
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11 


23:d 


1 


735 


11 


23:d 


1 
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11 
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11 


23t0 


156 



•segment proc offsets' »• • :35i*hex code*)! 
if not console then 

if control then write ( cr . • c ' . procnum : 2 » • 1 • ) 
else write( •.') \ 
linenum:=o; 

REPEAT 

HEX.WORO:=BUFSTART + BYTEPOS - PROCSTART; 

IF DISPLAY THEN URI TE ( LISTFlLE » SEGNUM: 7 , PROCNUM; 5 , HEX . WORD : 6 % • ( « 

HEXCHARC HEX. DUMIZNHEXCHARC HEX. HI H.HEXCHARi: HEX. LO :],•>: •): 
IF CONTROL AND NOT CONSOLE THEN 
BEGIN 

writecm; 

linenum:=linenum + 1; 

if (linenum mod 50=0) then write(cr»« •); 

END; 

hexcount:=o; 

code:=» »; 

bite:=getbyte; 
optotal:=optotal + l; 
case rectypescbite3 of 
short:shortop; 
cmprss:cmprssop; 
cmprss2:cmprss20p; 

ONEtONEOP? 

chrs:chrsop; 
blk;blkop; 

OPT:0PT0P! 

lopt:loptop; 

two:Twoop; 

words: WORDSOP; 

word:wordop 

end; 

UNTIL DONEPROC; 

end; 



END 



END 



PROCEDURE ALLPR-OCS; 

VAR I,J.V!AXDIST.INDEX:INTEGER; 

SORTNUMS:ARRAYC0..MAXPROCNUMD OF INTEGER; 

SORTpROCSrARRAYCO.-MAXPiiCN'JMa OF BYTE? 
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11 
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11 
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3 
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11 
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11 
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11 
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52 
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11 
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11 
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77 
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11 


23:5 
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11 


23:5 


83 


748 


11 
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749 


11 


23:7 


123 


750 


11 


23:8 


123 


75X 


11 


23:8 


136 


752 


11 


23:7 


139 


753 


11 


23:5 


146 


754 


11 


23:5 


168 


755 


11 


23:5 


191 


756 


11 


23:4 


220 


757 


11 


23:3 


227 


758 


11 


23:4 


252 


759 


11 


23:5 


252 


760 


11 


23:5 


265 


761 


11 
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302 


762 


11 
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304 


763 


11 
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311 
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11 


23:1 


311 


765 


11 
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338 
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11 


23:4 


338 
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11 
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375 


768 


11 


23:3 
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769 


11 
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770 


11 


23:0 
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771 


11 
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1 


772 


11 


24:0 





773 


11 


24:1 





774 


11 
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4 


775 


11 


24:3 


4 


776 


11 


24:3 


20 


777 


11 


24:2 


55 


778 


11 


?4:i 


5b 



begin 

if display then 

3EGI;\| 

sortnums:=procs5 

for i:=i to maxpkocnum do sortprocsci3:=i; 

FOR i:=i to procscod do 

BEGIN 

maxdist:=o; 
index:=o; 

FOR j:=I TO PROCSC03 DO 

IF SORTNUMSCJ3>=MAXDIST THEN 
BEGIN 

maxdist:=sortnumscj3; 
index:=u; 
end; 
sortnumscindex3:=sortnumsci3; 

SORTNUMSC 1 1: =SORTPROCSC index 3 ; 
SORTPROCSClNDEX3:=SORTPROCSCn; 
END? 
FOR l:=l TO PROCSC03 DO 

3EGIN 

pr0cnum:=s0rtnumsci3j 

if (not console) and (i mod 50=0) then write(cr«* ml 

procejur; 

END? 
END 
ELSE FOR PROCNUM:=l TO PROCSC03 DO 
BEGIM 

IF (NOT CONSOLE) AND (PROCNUM MOD 50=0) THEN WRITE(CR»» •)! 
PROCEJUR; 
END? 
END; 

PROCEDURE SEGMINT; 
BEGIN 

IF SWAP THEN 
BEGIN 

segstblk:=segdireccsegnum*4 + 13; 

segsize:=segdireccsegnum*4 + 33 + segdireccsegnum*4 + 23*256; 

END ^ 0r/ 

ELSE ->C3/ 
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24:i 


106 


784 


11 


24!1 


110 


785 


11 


24:2 


11a 


786 


11 


24:1 


123 


787 


11 


24:2 


131 


783 
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24:i 
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791 
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11 


8:4 


66 


805 


11 


8:4 


72 


806 


11 


8:5 


72 


807 


11 


8:5 


34 


808 


11 


8:3 


84 


809 


11 


8:2 


84 


810 


11 


8:4 


97 


811 


11 


8:5 


97 


812 


11 
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SE5ST3LK:=SE6DIRLCCSEGNU^*4 3: 

SEKSIZE:=SEGDIrECCSLGNUM*«|. + 33*256 + SEGDIRECCSEGIgUM*4 + 21; 
END! 
BUFST3lk:=SEGST3LK; 
IF SEGSIZE>2560 THEN 

BYTEP0S:=BUFRESET(SEGSl2Et-ltl) 
ELSE 

8YTEPOS:=BUFRESET(SEGSIZEt-l,0) ; 
PROCSC0]:=BUFFERCaYTEPOS3! (* NUMBER OF PROCS IN SEGMENT *) 
BYTEPOS:=BYTEPOS - 2*PROCSC03 - 1; 

for procnum:=procsco3 downto i oo procscprocnumd:=getword; 
if not (control or lexcheck) then allprocs; 
end; 

procedure actaccessi cfinalex , offset: integer ; 1 
var fimalproctfinalseg: integer; 
inside:boolean; 

BEGIN 

IF (FiNALEXrPROCLEXCDATAPROCD) AND (PROCNUM>=DATAPROC ) THEN 
IF SEGNUM=DATASEG THEN 
BEGIN 

inside:=(procnum=dataprqo ; 
finalproc:=procnum; 

while proclexcfinalproc3>proclexcdataproc3 do finalproc:=finalproc - 
if finalpr0c=datapr0c then 

CSR-3 

DSSTART^COFFSETD:=DSSTART^COFFSET3 + 1; 
C$R+3 

END 
ELSE IF (DATAPROC=D AND ( SEGNUM>DATASEG) THEN 
BEGIN 

finalseg:=segnum; 

WHILE SEGLEXCFINALSEG3>SEGLEXCDATASEG3 DO FINALSEG:=FINALSEG - 1; 
IF FINALSEG=QATASEG THEN 
CSR-3 

DSSTART*COFFSETD:=DSSTART A [:OFFSETJ + 1; 
CSR+3 

end; 
end; 
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PROCEDURE PROCGUIDE; 

TYPE SPACEPTR=~SPACE; 

SPACE=ARRAYC0..19D 

VAR ItjrINTEGER: 

dsspace:spaceptr; 



of integer; 



procedure dataseginf05 
var temp: integer; 

BEGIN 

procejur; 

bytepos:=bytepos - 2? 
if swap then 

BEGIN 

dtsgsz:=lastbyte; 
dtsgsz:=dtsgsz + lastbyte*256; 
temp:=lastbyte; 

DTSGSZ:=DTSGSZ + LASTBYTE*256 + temp; 
END 
ELSE 
BEGIN 

DTSGSZ:=LASTBYTE*256 5 

dtsgsz:=dts5sz + lastbyte; 
temp:=lastbyte*256; 
dtsgsz:=dtsgsz ♦ lastbyte + temp; 
end; 
dtsgsz:=dtsgsz div 25 

END! 

PROCEDURE PROCLOOK; 
BEGIN 

gotoxy(0»3)5 write( f »:50); gotoxy(0»3)5 
lexlook:=true; 

i:=(PROCSC0D DIV 5) + 1; 

FOR j:=0 TO ( (PROCSC03-1) DIV I) DO WRITE(« 

writeln; 

for procnum:=i to procscod do 

BEGIN 

dataseginfoj 

g0t0xy(15*( (procnum-1) div i ). 5+ <( procnum-1 ) mod i)); 
wRitE(procnum:5»':',lexlevel:3»dtsgsz:6) ; 
end; 



LL SIZE'); 






590 



861 11 27!1 212 FOR j:=i TO (5 - (PROCSCOH WO 5)) DO WRITELN5 

862 11 27:i 259 PROMPT; 

863 11 27:i 262 LEXLOOk : =FALSE ; 
86i+ 11 27:0 265 END! 

865 11 27:0 281 

866 11 25:0 BEGIN CPROCGUIOEU 

867 11 25U SEGMINT? 

868 11 25:1 2 REPEAT 

869 11 2512 2 PAGE ( OUTPUT ) ; 

870 11 25:2 12 WRITE! 'PROCEDURE GUIDE: #<0F PROCEDURE),'); 

871 11 25:2 58 IF LeXCHECK THEN 

872 11 25:3 62 WRlTELN! »L ( ISTlNG ) , Q ( UIT) ■ ) 

873 11 25:2 98 ELSE 

874 11 25:3 100 WRlTELNCAUL), LUSTING), Q(UIT)' ) ; 

875 11 25:2 142 WRITE(* TO SEGMENT: •){ 

876 11 25:2 168 FOR i:=l TO 8 DO WRITE < CHR ( SEGDIRECC63 + SEGNUM*8 + 13))} 

877 ii 25:2 211 procnum:=o; 

878 11 25:2 214 WRITE ( CR,CR, • WHICH PROCEDURE MS 

879 11 25:2 262 IF LEXCHECK THEN 

880 11 25:3 266 WRlTECDATA SEGMENT TO WATCH?') 

881 11 25:2 300 ELSE 

882 11 25:3 302 WRITE ( 'TO DIS-aSSEMBLE?' ) ; 

883 11 25.*2 330 READ(CH); 

884 11 25:2 340 IF (CH='L») OR (CH=*L») THEN 

885 11 25:3 349 PROCLOOK 

886 11 2512 349 ELSE IF ((CH='A«) OR <CH='A')) AND (NOT LEXCHECK) THEN 

887 11 25:4 366 BEGIN 

888 11 25:5 366 PAGE ( OUTPUT ) ; 

889 11 25:5 376 WRlTELN ( 'DIS-ASSEMBLING ALL* ,PROCSC 03: 3, • PROCEDURES' ,CR, CR ) 5 

890 11 25:5 478 IF NOT DISPLAY THEN WRlTEtCR ,CR» ' ( ' . SEGNUM:2, • ) • ) ; 

891 11 25:5 532 ALLPROCS; 

892 11 25:5 534 PROMPT; 

893 11 25:5 537 CH^'Q'! 

894 11 25:4 540 END 

895 11 25:3 540 ELSE IF (CH>='0») AND (CH<='9M THEN 

896 11 25:5 551 BEGIN 

897 11 25:6 551 PROCNUM: =ORD(CH) -ORD( • • ) ; 

898 11 25:6 556 READ(CH); 

899 11 25:6 566 IF (CH>= , O f ) AND (CH<= , 9») THEN 

900 11 25:7 575 PROCNUM: =PROCNUM*10 + ORD(CH) - ORD('0»); 

901 11 25:6 584 IF (PR0CNUM<1> OR ( R*^OUM>PROCSC 1 ) THEN 



902 11 25:7 8P* BEGIN 

904 JJ lilt fin WRITELN(CR.«I DIDWT SAY YOU HAD THAT PROCEDURE!') 
7U1 ■»■■'■ « • 8 670 PROMPT! 

905 11 25:7 673 END 

ont J J ~V b 6?3 ELSE IF N0T LEXCHECK THEN 

907 11 25:8 680 BEGIN 

l°* t 1 25:9 &80 PAGE(OUTPUT); 

910 11 «il %ll WRITELNCDIS-ASSEMBLING PROCEDURE » ,PR0CNUM:3 ,CR) ? 

„7!r ii ^ b ' 9 7b4 PROCEJUR; 



e» PROMPT 



ch: = 



• - 1 » 



911 11 25:9 75_ 

912 11 25:9 759 

913 11 25:8 762 END 
911 11 25:7 762 EL SE 
915 11 25:8 764 BEGIN 

qiS 77 ?= :9 764 DATAPROC:=PROCNUM; 

oVo J: 5= 7&7 dataseg:=segnums 

918 11 25!9 770 DATASEGlNFO; 

Ill JJ 25J9 772 DATASEGSIZE:=DTSGSZ5 

9P? }J ! 9 776 NEW(DSSTART); 

922 11 25-9 Inq FOR 1-1 TO ((DATASEGSIZE+19) DIV 20) DO NEW(DSSPACE); 

923 \\ ll'-l «?a FILLCHAR<DSSTART%DATASEGSIZE*2,0); 

HI ii skIo S, 1 ! for pr °cnum:=i to procscod do 

'*:t IX <£O.Q 840 BEGIN 

925 11 25:i 840 PROCEJUR; 

III i\ ll\ l n H z proclexcprocnumd ; =lexlevel; 

?^7 11 25:0 854 end; 

928 11 25:9 861 CH:=CHR< 7 >; 

929 11 25:8 864 END; 

930 11 25:5 864 END; 

932 U till 8 8 77 END;' 11 (CH=,Qn ° R (CH= * Q,) ° R < CH=CHR <7>>< 

933 11 25:0 908 

934 11 28:D 1 PROCEDURE SEGMTGUIDE; 

935 U 28:0 1 V AR I,j:i N TEGER; 

936 11 28:0 3EGIN 

937 11 28!1 o REPEAT 

938 U 28.-2 PAGE(OUTPUT); 

III H ll\l I? WRIT E LN(»SEGMENT GUIDE: «<OF SEGMENT). Q(UIT)M ; 

qa? 11 ll\l A G *RITELN(CR,CR.'Y0U HAVE THESE SEGMENTS."); 

*tl ll 28.2 130 FOR I;=0 TO 15 DO 

942 U 18:3 141 BEGIN 391 



.193 



943 11 23:4 mi ,RITE(I:<+,' •); 

344 11 28:4 ib9 FOR J.*=l TO f j DO wRITE < CHR ( SEGDIRECC 63 + 1*8 + J})); 

945 11 28J4 212 WRlTELN; 

946 11 28:3 220 END; 

947 11 28:2 227 WRITE ( CR , • WHICH SEGMENT TO LOOK AT Mi 

948 11 28:2 274 IF L-EXCHECK THEN 

949 11 28:3 273 WRITE! 'TO DECIDE ON DATA SEGMENT? 1 ) 

950 11 28:2 316 ELSE 

951 11 28:3 318 WRlTE(»FOR POSSIBLE DIS-ASSEMBLY?' ) ; 

952 11 28:2 356 READ(CH); 

953 11 28.*2 366 IF (CHO'O'J AND (CHO'Q'J THEN 

954 11 28:3 375 BEGIN 

955 11 28:4 375 SEGNUM:=0; 

956 11 28:4 378 IF <CH>=»0') AND <CH<=*9») THEN SEGNUM:=ORD(CH) -ORD ( • • ) 5 

957 11 2S.-4 392 READ(CH); 

958 11 28:4 402 IF (CH>=»0») AND (CH<=«9») THEN 

959 11 28:5 411 SEGNUM:=SEGNUM*10 + ORD(CH) - ORD('O'); 

960 11 28:4 420 IF ( SEGDIRECC4*SEGNUM3 + SEGDIRECC4*SEGNUM + 13=0) OR (SEGNUM>15) THEN 

961 11 28:5 455 BEGIN 

962 11 28:6 455 WRITELN(CR» • I DIDN»'T SAY YOU HAD THAT SEGMENTIM; 

963 11 28:6 519 READ (KEYBOARD, CH ) ! 

964 11 28:5 529 END 

965 11 28:4 529 ELSE 

966 11 28:5 531 BEGIN 

967 11 28:6 531 PROCGUIDE5 

968 11 28:6 533 IF CHOCHR17) THEN CH:=»A»! 

969 11 28:5 541 END; 

970 11 28:3 541 END; 

971 11 2B:i 541 UNTIL (CH=»Q») OR (CH=»QM OR (CH=CHR(7))J 

972 11 28:0 554 END; 

973 11 28:0 574 

974 11 29:D 1 PROCEDURE LEXGUIDE; 

975 11 29:0 BEGIN 

976 ii 29:i o lexcheck:=true; 

977 11 29:i 3 dataseg:=-i; 

978 11 29:i 7 REPEAT 

979 11 29:2 7 SEGMT&UIDE; 

980 11 29:2 9 IF (CHs'QM OR (CH=»Q») THEN 

981 11 29:3 19 BESIN 

982 11 29:4 18 PAGE ( OUTPUT ) ; 

933 11 29:4 29 30T0XY ( » 10 ) ; 
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130 
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130 
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11 
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139 
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11 
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143 
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11 
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154 
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11 


29:4 


135 
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185 
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11 
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187 
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11 


29:5 


190 
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11 
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192 
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11 
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204 


998 


11 
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204 
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11 
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224 


1000 


11 
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234 
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11 
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11 
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11 
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148 
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11 
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158 
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167 
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11 
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11 
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253 
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266 
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11 
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1:3 
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11 
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reJdTkey3Sard,cSm CHANGE ° Y0UR MIND about oata segment watching?m; 

IF <CH='Y») OR (CH='Y») THEN DATAwATCH:=FALSE; 
END; 

UNTIL <CH=CHR(7)> OR (NOT DATAWATCH); 
IF DATAWATCH THEN 

FOR segnum:=o TO IS DO 

IF SEGDIRECC4* S EGNUM] + SEGOIRECC 4*SEGNUH + 13<>0 THEN 
3EGIN 

SEGMINT! CSETS UP APPROPIATE SEGMENTS 
PROCNUM:=l; 

PROCEJUR; CSETS UP PROCEDURE TO DETERMINE SEGMENT'S LEXLEVEL!! 
SEGLEXCSEGNUM]:=LEXLEVELi atuntwi a LtXLtVELU 

END 

else seglexcsegnum3:=100; 
page(output); 
lexcheck:=false? 
end; 

BEGIN {* SEGMENT DISASSEMBLE *) 
PAGE(OUTPUT)? 
GOTOXY(OtlO)! 

WR3CT E<' , °0 Y °U WISH TO KEEP TRACK OF REFERENCES' ,CR. 

READ(KEY80ARD,CH); T0 * PARTICULAR W°CEDURE"S ^TA SEGMENT?', , 
DATAWATCH: = (CH='Y') OR (CH='YM; 

PAGE A o2?pJn; THEN LEXGUIDE ELSE "-"CHECK :=FALSEJ 

GOTOXY(OflO) 1 

WRITECDO YOU WISH CONTROL OVER DIS-ASSEMBLY?* ) 5 
READ(KEYBOARD,CH); T ' 

control:=<ch='y», or <ch='Y»>{ 
if control then 

BEGIN 

PAGE(OUTPUT) ; 

GOTOXY(0.7); 

WRITE(CHR(7,,; 

ss»";::%rS2kjsi s ; H [ r s :::;?: ,cs are gathered ° n «-»«**«>.» 

IF DATAWATCH THEN WRITELN(CR ,CR, • t, 

♦*** THIS INCLUDES DATA SEGMENT WATCHING ** * { 393 
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REAQ(KEYBOARQiCH) ; 
SE3MTGUIDE5 
ENO 
ELSE 
BEGIN 

IF NOT CONSOLE THEN WRITE ( CHR ( 12 ) tCR > ! 
FOR SEGNUM:=0 TO 15 DO 
3E&IN 

IF NOT CONSOLE THEN WRITE ( CR • • ( * » SEGNUM : 2 » • ) * ) J 

IF SEGDIREC!I4*SEGNUMD + SEGDIRECC4*SEGNUM + 1]<>0 THEN SEGMlNT; 
END; 
PROMPT; 

end; 
end; 

(*$i disasm1.text *) 
(*$i disasm2.text*) 

cstart of disasm2.text3 
ccopyright (c) regents of university of california at san diegod 

segment procedure gather; 
var filename:string; 

procedure writehdr(var h: interactive 5 header! integer) ; 

5EGIN 

CASE HEADER OF 

l: WRlTELN(Ht f PARAMETER ONE')! 

2: WRITELNCH.'BITS USED TOTAL PERCENTAGE*); 

3: WRlTELN(H,« PARAMETER ONE PARAMETER TWO »); 

4: WRlTELN(Hf ♦BITS USED TOTAL PERCENTAGE TOTAL PERCENTAGE' ) J 

5: WRITELN(H«' PARAMETER ONE PARAMETER TWOS 

• CASE TABLE SIZE'); 



6: 
7; 

8; 
END: 

end; 



WRITELN(H,»BITS USED TOTAL 
WRjTELN(Hi 'FLAVOR TOTAL 
WRITELN(H»* U TOTAL PCT 



PERCENTAGE 

1 

PERCENTAGE 
f 

U TOTAL 
1 



TOTAL PERCENTAGE* » 

TOTAL PERCENTAGE'); 
FLAVOR', 
TOTAL PERCENTAGE'); 

PCT H TOTAL' . 

PCT # TOTAL PCT») 



1065 12 3:D 1 PROCEDURE JUMPSTUFF; 

1066 12 3:0 1 VAR IUnTEGER; 

1067 12 3:0 U BEGIN 

]nt* \\ V\\ ° WR . IT ELN(LISTFILE,CP,'JUN|P STATISTICS ON THE' , JUMPTOTAL: 5 , • TOTAL JUMPS'); 

XUb9 12 3:i 87 IF JUMptOTAL>0 THEN 

1070 12 3.*2 93 BEGIN 

1071 12 3:3 93 WRITELN(LISTFILE»CR| 

1073 \\ Hi JSf a , POSITIVE JUMPS NEGATIVE JUMPS'); 

1073 12 3:3 176 WRlTEHDR (LISTFILE , 4 ) ; 

1074 12 3:3 132 KITH JUMPSTATS DO 

1075 12 3l*f 182 FOR i:=0 TO 15 DO 

Hit \l \\\ J'J WRITELN(LISTFlLE,I + i:5,POSCI3:i3,POSCn/JUMPTOTAL*100:m:2, 

1078 12 3«2 312 E NEGC I 3: 9, NEGC I VJUMPTOTAL*100 : 14:2) ; 

1080 12 3' 1 312 E ^ SE WRlTELN(LISTFlLE,CRf,S0RRY NO JUMPS TODAY!'); 

1081 12 3:0 382 

1082 12 5:D 1 PROCEDURE PROCSTUFF; 

1083 12 5:D 1 VAR IiJ:INTEGER! 

1084 12 5.-0 BEGIN 

J25* \\ V 1 ° WR ITELN(LISTFII_E,CR. 'PROCEDURE CALL STATISTICS' ) ; 

1086 12 5:i 55 FOR i:=o TO 15 DO 

1087 12 5:2 66 IF PROCCALLC I DONIL THEN 

1088 12 5:3 80 FOR J:=l TO MAXPROCNUM DO 
iSoo \l V* 93 IF p ROCCALLCl3' , [:j3>0 THEN 

1091 \l V-t \\% WRITELN(LISTFILE,« SEGMENT: ', I :4, ' PROCEDURE: • ,J!4, 

1092 12 sio 252 END; ' CAL ^: SPROCCALLC ID-C J3:4 ) ; 

1093 12 5:0 274 

1094 12 6:D 1 PROCEDURE HISTOGRAM ( PCTMAX: INTEGER ) ; 

1095 12 6:D 2 VAR I .'INTEGER; 

1096 12 6:0 3EGIN 

}nll 12 6!1 ° PC TMAX;=ROUND(PCTMAX/MAXOP*20); 

1098 12 6.-1 12 FOR i:=i TO PCTMAX DO WRITE ( LISTFILE t ♦*•) ; 

1099 12 6.*0 40 END; 

1100 12 6:0 54 

1101 12 7:D 1 PROCEDURE SHORTSTUFF; 

1102 12 7.-D 1 V AR I:I.\| T EGER! 

1103 12 7:D 2 

1104 12 a:0 1 PROCEDURE SHORTKVAR H: INTERACTIVE) ; 

H05 12 a:o o begin 395 
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1106 12 a:i j wRITEH,CR,»SLCC OPCODE: 0..127 TOTAL:*, 

1107 iz a:i 43 sldc:s,sldc/optotal*ioo:i6:2, ' % •); 
1103 12 a:i 37 histdgramcsloc) ; 

1109 12 8:i 91 IF SLDCOO THEN 

1110 12 8:2 97 BEGIN 

1111 12 8J3 97 WRITELN(H.CR); WRITEHDR ( H, 8 ) ; 

1112 12 8:3 115 FOR OP:=0 TO 31 DO 

1113 12 8:4 126 /JRITELN(H,OP:4.»:',OPCODECOPJ^.TOTALO:7»OPCODECOP3 A .TOTALO/SLDC*100:7:2» 

1114 12 8:4 138 OP+32:4»»:«,OPCOQECOP+32D A .TOTALQ:7,OPCODECOP+32;r.TOTAL0/SlDC*100:7:2, 

1115 12 8:4 256 0P + 64 : 4 , • .* • , OPCODEC 0P + S4 D A . TOTAlO I 7 , OPCODEC OP+643*. T0TAL0/SLDO1Q0 1 7 : 2 , 

1116 12 8:4 324 0P + 96 :4 i • : • , OPCODEC 0P+96D' V . TOTAlO I 7 i OPCODEC 0P+96D*. T0TAL0/SI.DO100 : 7 : 2 ) 

1117 12 8:2 405 end; 

1118 12 8:1 405 WRITE(H,CR,CRi 'SLDL OPCODE: 216. .231 TOTAL.:*! 

1119 12 8:i 461 SLDl:8,SLDL/OPTOTAL*100:16:2,» % »); 

1120 12 8:1 500 HISTOGRAM(SLDL) ? 

1121 12 8:i 504 IF SLDLO0 THEN 

1122 12 8:2 510 BEGIN 

1123 12 8:3 510 WRITELN(H,CR)5 WRITEHDR (H, 8 ) 5 

1124 12 8:3 528 FOR 0P:=216 TO 219 DO 

1125 12 8:4 543 WRITELN ( Hi OP:4i • : « t OPCODECOPD*. TOTALO :7,OPCODECOP3'\TOTAL0/SLDL*100 : 7: 2, 

1126 12 8:4 605 0P+4:4 ,» I », OPCODEC OP+4 IT. TOTALO :7 tOPCODECOP+43«,TOTAL0/SLDL*l00 :7:2 i 

1127 12 8:4 673 0P+8:4t •:• «OPCODECOP+83", TOTALO : 7i OPCODECOP+83 A .TOTAL0/SLDL*100 : 7:2i 

1128 12 8:4 741 OP+12 : 4 » ♦ I • , OPCODECOP+123*. TOTALO : 7 , 0PC0DEC0P+12D*. T0TAL0/SLDL*100 1 7: 2 ) 

1129 12 8:2 822 END? 

1130 12 8:0 822 END; 

1131 12 8:0 846 

1132 12 9:D 1 PROCEDURE SHORT2(VAR h: INTERACTIVE ) ; 

1133 12 9:0 BEGIN 

1134 12 9:i WRITE(H,CR,CR, »SLDO OPCODE: 232. ,247 TOTAL: 1 , 

1135 12 9:i 56 SLDO:8,SLDO/OPTOTAL*100:i6:2»* % *)\ 

1136 12 9:1 95 HlSTOGR(\M(SLDO) ; 

1137 12 9:i 99 IF SLDOOO THEN 

1138 12 9:2 105 BEGIN 

1139 12 9:3 105 WRITELN(H.CR) ; WRITEHDR ( H, 8 ) ; 

1140 12 9:3 123 FOR 0P:=232 TO 235 DO 

1141 12 9:4 138 WRlTELN(H.0P:4t':« i OPCODEC OPIT . TOTALO : 7i OPCODECOP:r.TOTAL0/SLDO*100 : 7 : 2 i 

1142 12 9:4 200 OP+4 : 4 ,»:• i OPCODEC OP + 4 3 A . TOTALO : 7 ♦ 0PC0DECOP+4ir ,TOTALO/SLDO*100 111 2 » 

1143 12 9:4 268 OP+8 : 4 i • : • i OPCODEC OP+83 A .TOTALO : 7, OPCODECOP+8D~,TOTAL0/SLDO*100 : 7: 2 » 

1144 12 914 336 OP + 12 '. 4 ,♦:• i OPCODEC 0° + 12 D A . TOTALO :7t 0PC0DEC0P + 12 1" . TOTAL0/SLDO*100 : 7 : ; 

1145 12 9:2 417 END? 

1146 12. 9:i 417 WRITEfH.CR.CR.'SlND OPCOCjfl* 248. . 255 TOTAL:*i 



1147 
1143 
1149 
1150 
1151 
1152 
1153 
1154 
1155 
1156 
1157 
1153 
1159 
1160 
1161 
1162 
1163 
1164 
1165 
1166 
1167 
1168 
1169 
1170 
1171 
1172 
1173 
1174 
1175 
1176 
1177 
1178 
1179 
1180 
1181 
1182 
1183 
1134 
1185 
1186 
1187 



12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 
12 



9: 
9 
9; 
9 

9: 

9 
9 

9: 
9; 
9: 
9: 
9; 
9; 
9: 
7: 
7; 

7 

7: 
7: 
10: 
10: 
10; 
10: 
10: 
10: 
10: 
10 
10 
11 
11 
11 
11 
ll; 
11 
ll 
n 
ll 
ll, 
11: 
11: 
M 



1 
1 
1 
2 
3 
3 
4 
4 
4 
4 
2 
1 



1 
1 


D 
D 

1 
1 
1 
1 


D 
D 

1 
2 
3 
3 
3 
4 
5 
5 
5 
5 



473 

312 

516 

522 

522 

540 

555 

617 

685 

753 

834 

834 

340 

864 





5 

10 

22 

1 

1 





14 

57 

60 

68 

30 

1 

1 





13 

13 

17 

60 

66 

66 

70 

38 

102 



siud:8,sind/optotal*ioo:i6:2i ' % ') 



HISTOG 

IF SIM 

3EGI 

inlR 

FO 



END! 
WRITEL 

end; 



RAM(SIND) 

doo then 

N 

ITELN(H«C 

R 0P:=248 

WRITELNCH 

OP+2 

OP + 4 

OP + 6 



R); WRITEHDR(H.8) ! 

TO 249 DO 
,0P:4i»: »«OPCOQEC0P:r.TOTAL0:7»OPC0DECOP:r.TOTAL0/SlND*100:7:2« 
:4,«: , .OPCODECOP+2 3%TOTALO:7»OPCODECOP+23~.TOTALO/SIND*100:7:2, 
:4,': , «OPCODECOP+4:r.TOTAL0:7iOPCODECOP+4:r.TOTAL0/SlND*100:7:2t 
:4t •: »«OPCODECOP+63' % .TOTALO:7»OPCODECOP+6 3' S .TOTALO/SIND*100:7:2) ; 



BEGIN** SHORTSTUFF *) 

SHORTI(LISTFILE) ? 

SH0RT2(LISTFILE) 5 
END! 

PROCEDURE SHORTST! 
VAR I : INTEGER! 
BEGIN 

inum:=opcodecopd a .totalo; 

WRITEtLlSTFILEtlNUMlStlNUM/OPTOTAL + lOOae^.* % »); 

histogramunum); 
writeln(listfile) ; 

end; 

procedure onest; 
var i:inTEger; 

BEGIN 

WITH OPCODECOPIT 00 

BEGIN 

inum:=totali; 

WRlTE(LISTFILE»INUM:8,lNU'^/OPTOTAL*100:i6:2i ' % *)? 
IF T0TAL1O0 THEN 
3EGIN 

HISTOGRAM(TOTALl) ! 

WRITELN(LISTHLE«CR) ! 

WRITEHDR(LISTFlLEtl) ! WRITELN ( LISTFILE) ! 

WRITEHDR(LISTFlLEt2f 
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59S 



1138 12 ii:5 my for i: = o to 7 do 

1139 12 1U6 119 WKITELfJ(LISTFlLE»I + i:5i3YTEONElCID:i3tBYTEONElCI3/TOTALl*100:l'*:2)« 

1190 12 11:4 192 Z'mZ 

1191 12 11:3 192 ELSE WR I TELN ( LISTFILE ) 5 

1192 12 11:2 202 END J 

1193 12 1110 202 END; 

1194 12 ll:0 21fl 

1195 12 12!D 1 PROCEDURE TWOST; 

1196 12 12ID 1 VAR i:integer; 

1197 12 12:0 BEGIN 

1198 12 12:1 WITH OPCODECOPiT DC 

1199 12 12:2 13 BEGIN 

1200 12 12:3 13 WRITE(LISTFILE,TOTAL2:8,TOTAL2/OPTOTAL*100:16:2,» % ')! 

1201 12 12:3 58 HIST0GRAM(T0TAL2) ; 

1202 12 12:3 62 WRITELN(LISTFILE»CR) ! WRITEHDR ( LISTFILE. 3) J 

1203 12 12:3 86 WRITELN(LISTFILE); WRITEHDR ( LISTFILE. 4 ) 5 

1204 12 12:3 100 IF TOTAL2=0 THEN 

1205 12 1214 106 FOR i:=0 TO 7 DO 

1206 12 12:5 117 WRITELN(LISTFILE. I+i:5, BYTE0NE2CID:13,0. 0:14:2, BYTETW02tn:9,0.0:i4:2) 

1207 12 12:3 206 ELSE 

1208 12 12:4 215 FOR i:=0 TO 7 DO 

1209 12 12:5 226 WRITELN(LISTFILE. I + i:5, BYTEONE2Cn:i3,BYTEONE2Cn/TOTAL2*l00:i4:2, 

1210 12 12:5 284 BYTETW02CI3:9,BYTETW02Cn/TOTAL2*100:if :2) ! 

1211 12 12:3 345 IF OP=205 THEN 

1212 12 12:4 352 3EGIN 

1213 12 12:5 352 WRITELN(LISTFILE) 5 WRITEHDR (LISTFILE .7 ) ; 

1214 12 12:5 366 IF TOTAL2=0 THEN 

1215 12 12:6 372 FOR i:=2 TO 15 DO 

1216 12 12:7 383 WRITELN(LlSTFlLE,NAMESC56+i:,FLAV0R2CID:9, 0.0:14:2,' •. 

1217 12 12:7 461 NAMESC56+I+14D.FLAVOR2CI+143:9»0,0:14:2) 
1216 12 12:5 534 ELSE 

1219 12 12:6 543 FOR i:=2 TO 15 DO 

1220 12 12:7 554 WRITELN(LISTFILE.MAMESC56+ID.FLAV0R2CI3:9, 

1221 12 12:7 600 FLAVOR2CID/TOTAL2*100:l ( *:2.» •, 

1222 12 12:7 646 NAMESC 56+I+143.FLAV0R2C 1+14 D : 9 » 

1223 12 12:7 696 FL.AV0R2C I + 143/TOTAL2*100 : 14 : 2 ) ; 

1224 12 12:4 742 END; 

1225 12 12:2 742 END! 

1226 12 12:0 742 END? 

1227 12 12:0 774 

1223 12 13:D 1 PROCEDURE ^ORDST; 



1223 


12 


13 :d 




1230 


12 


13 :o 





1231 


12 


13; i 





1232 


12 


13:2 


13 


1233 


12 


13:3 


13 


1234 


12 


13:3 


17 


1235 


12 


13:3 


60 


1236 


12 


13:4 


66 


1237 


12 


13:5 


66 


1238 


12 


13:5 


7C 


1239 


12 


13:5 


94 


1240 


12 


13:5 


108 


1241 


12 


13:6 


119 


1242 


12 


13:4 


192 


1243 


12 


13:3 


192 


1244 


12 


13:2 


202 


1245 


12 


i3:o 


202 


1246 


12 


13:0 


218 


1247 


12 


14 :d 


1 


1248 


12 


14:d 


1 


1249 


12 


14:o 





1250 


12 


i4:i 





1251 


12 


14:2 


13 


1252 


12 


14:3 


13 


1253 


12 


14:3 


17 


1254 


12 


14:3 


60 


1255 


12 


14:4 


66 


1256 


12 


14:5 


66 


1257 


12 


I4:s 


70 


1258 


12 


14:5 


94 


1259 


12 


14:5 


108 


1260 


12 


14:6 


119 


1261 


12 


14:6 


177 


1262 


12 


14:5 


238 


1263 


12 


14:6 


249 


1264 


12 


14:4 


322 


1265 


12 


i4.*3 


322 


1266 


12 


14:2 


332 


1267 


12 


14:0 


332 


1268 


12 


i4:o 


350 


1269 


12 


\5:d 


1 



\/ar i: integer; 

BEGIN 

jrflTH OPcOOtTOP]* 00 

BEGIN 

inuni:=total3; 

WRlTE(LlSTFILE,INUM:8,lNUM/OPTOTAL*l00:i6:2t' % '); 
IF T0TAL3O0 THEN 
BEGIN 

HIST0GRAM(T0TA|_3> ; 

WRITELN(LISTFILE»CR) ; WRITEHDR (LISTFILE* 1 ) J 

WRITELN(LISTFILE) ; WRITEHDR (LISTFI|_E»2) ; 

FOR i:=0 TO 15 DO 

WRITELN(LlSTFILE»I + l:5.PARMONE3Cn:i3»PARMONE3Cn/TOTAL3*l00:i4:2) j 

END 

else writeln(listfile)? 
end; 

END? 

procedure loptst; 
var i:integer; 

BEGIN 

WITH OPCODECOP3* DO 
BEGIN 

inum:=total4; 

WRITE(lISTFILE♦INUM:8,INUM/OPTOTAL*100:l6:2l , % '); 
IF T0TAL4O0 THEN 

BEGIN 

HIST0GRAM(T0TAL4) J 

WRITELN(LISTFILE»CR) 5 WRITEHDR(LlSTFILEt 3) { 
WRITELN(LISTFILE) 5 WRITEHDR (LISTFILE»4) ; 
FOR i:=0 TO 7 DO 

WRITELN(LlSTFILE.I+i:5tBYTEONE4CI3:i3tBYTEONE4CI3/TOTAL4*100:i4:2, 
PARMTW04CI3:9»PAR»1TW04CI3/TOTAL4*100:14:2); 
FOR i:=8 TO 15 DO 

WRITELN(LlSTFILE»I+i:5iPARMTW04CID:36»PARMTW04CI3/TOTAL4*lOO:l4:2) i 

END 

else writeln(listfile) ! 

end; 
end; 



PROCEDURE WORDSST; 
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GOO 



127u 


12 


15:j 


i 


1271 


12 


i5:a 





1272 


12 


15:1 





1273 


12 


15:2 


13 


1274 


12 


15:3 


13 


1275 


12 


15:3 


17 


1276 


12 


15:3 


60 


1277 


12 


15:4 


66 


1278 


12 


15:5 


66 


1279 


12 


is: 5 


70 


1280 


12 


15:5 


94 


1281 


12 


15:5 


108 


1282 


12 


15:6 


119 


1283 


12 


15:6 


177 


1284 


12 


15:6 


223 


1285 


12 


15:4 


284 


1286 


12 


15:3 


284 


1287 


12 


15:2 


294 


1288 


12 


15:0 


294 


1289 


12 


15:0 


312 


1290 


12 


16:d 


1 


1291 


12 


16:d 


1 


1292 


12 


i6:o 





1293 


12 


i6:i 





1294 


12 


16:2 


13 


1295 


12 


16:3 


13 


1296 


12 


16:3 


58 


1297 


12 


16:3 


62 


1298 


12 


16:3 


36 


1299 


12 


16:4 


92 


1300 


12 


16:5 


92 


1301 


12 


16:6 


103 


1302 


12 


16:6 


179 


1303 


12 


16:5 


255 


1304 


12 


16:4 


320 


1305 


12 


16:3 


320 


1306 


12 


16:4 


322 


1307 


12 


16:5 


322 


1308 


12 


16:6 


333 


1309 


12 


16:6 


377 


1310 


12 


16:6 


404 



var i : integer; 

BEGIN 

WITH OPCODECOPIT DO 
BEGlxi 

inum:=total5; 

«iRlTE(LlSTFILE,INUM:8,lNUM/OPTOTAL.*100:i6:2» * % '); 
IF T0TAL5O0 THEN 

3EGIN 

HIST0GRAM(T0TAL5) ; 

WRITELN(LISTFILEiCR) 5 WRITEHDR ( USTFILE» 5) ; 
WRITELN(LISTFILE); WRITEHDR ( LISTFILE.6) 5 
FOR i:=0 TO 15 DO 

WRITELN(LISTFILE*I+1:5»PARMONE5CI3:13.PARMONE5CI3/TOTAL5*100:14:2. 
PARMTWo5Cn:9,PARMTW05CID/TOTAL5*l00:i4:2, 
PARMTHREE5CI3:9,PARMTHREE5CI3/TOTAL5*100:14:2); 

END 

else writeln(listfile) ! 
end; 
end; 

procedure cmprssst5 
var i:integer; 

BEGIN 

WITH OPCODECOPIT DO 
BEGIN 

WRITE<LISTFILE»TOTAL6:8,T0TAL6/OPT0TAL*100:16:2» , % ♦); 
HlST0GRAM(T0TAL6) i 

WRlTELN(LlSTFlLEtCR) ; WRITEHDR < LISTFILE , 7 > ; 
IF TOTAL6=0 THEN 
BEGIN 

FOR l:=0 TO 19 DO 

WRITELN(LISTFILE»NA^ESC86+I3,FLAVOR6CID:9»0.0:14:2,» », 
NAMESC 106+1 3»FLAV0R6C 1+20 :: 9,0.0: 14:2) ; 

WRITELN( LISTFILE tNARESC1263:44,FLAV0R6C403: 9.0.0: 14: 2) ! 

END 

ELSE 
3EGIN 

FOR i:=0 TO 19 DO 

WRITELN(LISTFILE»NAMESC86+ID,FLAV0R6CID:9, 
FLAVOR6ClD/TOTAL6*100:i4:2t 
NAMESC 106 + 1 ]:&^LA\/0R6C 1 + 20 :): 9. FLAV0R6C 1+20 3/T0TAL6*l00^:2) ; 



1311 
1312 
1313 

13m 

1315 

1316 

1317 

1318 

1319 

1320 

1321 

1322 

1323 

1324 

1325 

1326 

1327 

1328 

1329 

1330 

1331 

1332 

1333 

1334 

1335 

1336 

1337 

1338 

1339 

1340 

1341 

1342 

1313 

1344 

1345 

1346 

1347 

1348 

1349 

1350 

1351 



12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 

12 



16: 
16: 
16; 
16: 
16: 
i&: 
17: 
17: 
17: 
17: 
17: 
17: 
17: 
17: 



17:3 
17:3 
17:4 
17:5 
17:6 
17:5 
17:6 
17:5 
17:4 
17:2 
17:0 
i7:o 
is:d 
ie:o 
I8:i 
i8:i 
18:2 
18:3 
ie:3 
18:3 



18, 
18: 

18; 

18; 
18; 

18; 

\a: 



<+9<+ 

517 

571 

571 

571 

596 

1 

1 



U 

13 

13 

17 

60 

64 

88 

99 

99 

104 

195 

197 

275 

290 

297 

297 

314 

1 





3 

18 

31 

46 

56 

70 

82 

94 

106 

118 

124 

165 



WRI TELNC LI STFILE. NAMESC 126 3:44, 

FlAVOR6C40 3:9.FlAVOR6C40 3/TOTAL6*100:14:2) ; 



end; 



end; 
end; 

procedure cmprss2st; 
var i:integerj 

BEGIN 

WITH OPCODECOPIP DO 
BEGIN 

inum:=total7; 

WRITe(LISTFILEiInUM:B,INUM/3PTOTAL*100:16:2»» % Mi 
HIST0GRAM(T0TAL7) ; 

WRITELN(LISTFILEiCR) 5 WRlTEHDR ( LISTFILE»7) ; 
FOR i:=l TO 6 DO 
BEGIN 

IF INUMOO THEN 

WRITE(LISTFlLE,NARESC5l+i:,FLAVOR7Ci::9»FLAVOR7Cn/INUM*100:i4:2«» 
ELSE 



») 



WRITE ( LISTFlLEf NAMESC 51 + 1 :,FLAV0R7C I :i:9» 0.0:14:2 1 • 
IF (I MOD 2=0) THEN WRITELNt LISTFILE) ; 

END; 
END; 
END; 

PROCEDURE GlNITt 
BEGIN 

maxop:=o; 

for 0p:=128 to 215 do 

WITH OPCODECOPD^ DO 
CASE RECTYPESCOP3 OF 
ONEtCHRS,BLK:iF 

two:if 

*lORD f OPT:iF 

lopt:if 

woRDs:if 
cmprss:if 

CMPRSS2:iF 



* ) : 



) 



(T0TAL1>MAX0P) then maxop:=totali ; 

(total2>maxop> then maxop:=total2; 

(t0tal3>max0p) then max0p:=total3 ; 

<t0tal4>max0p) then max0p:=t0tal4 ; 

(t0tal5>max0p) then max0p:=t0tal5 ; 

<t0tal6>max0p) then max0p:=t0tal6; 

(t0tal7>max0p) then max0p:=t0tal7 



ends 



END' 



GDI 



r+ ,"\ .—* 



1352 12 13: 162 

1353 12 III) 3EGIN (* SEGMENT PROCEDURE GATHER *) 

135^ 12 1:1 o ginit; 

1355 12 111 2 PAGE(OJTPUT) ; 

1356 12 l:i 12 GOTOXY{0»10) J 

1357 12 i:i 17 WRITE(CriR(7) , 'OUTPUT FILE FOR OPCODE STATISTICS <<CR> FOR NONE): •)? 

1358 12 i:i 90 READLN(FILENAME) J 

1359 12 111 109 DISPLAy:=(FILENAME<> ,, >; 

1360 12 i:i 118 CONSOLE: = (FILENAMEr: , CONSOLE: * ) OR <FILENAME=*#1 : ' ) ; 

1361 12 i:i 146 IF DISPLAY THEN 

1362 12 1:2 149 BEGIN 

1363 12 1:3 149 IF ( FILENAMEOLASTFILENAME ) THEN 

1364 12 1:4 158 3EGIN 

1365 12 115 158 CLOSEUISTFILE.LOCK) ; 

1366 12 115 167 REWRITE(LISTFILE, FILENAME); 

1367 12 1!5 179 LASTFILENAME:=FILENAME; 

1368 12 1:4 186 END; 

1369 12 113 186 PAGE(OUTPUT) J 

1370 12 1:3 196 PROCSTUFF; 

1371 12 1Z3 198 JUMPSTUFF! 

1372 12 1:3 200 SHORTSTUFF! 

1373 12 1:3 202 FOR 0P:=128 TO 215 DO 

1374 12 1:4 218 BEGIN 

1375 12 1:5 218 WRITE(LISTFILE,CR.NAMESC0P3»' OPCODE: • 1 OP: 4, • TOTAL:*); 

1376 12 1:5 303 CASE RECTYPESCOPD OF 

1377 12 1:5 318 SHORT:SHORTST! 

1378 12 1:5 322 OpT, WORD: WORDST 5 

1379 12 i:5 326 ONE, CHRS 1 BLK :ONEST 5 

1380 12 1:5 330 TWOtTWOST; 

1381 12 i:5 334 LOPT:LOPTST; 

1382 12 1:5 338 WORDS: WORDSST ; 

1383 12 1:5 342 CMPRSS:CMPRSSST ; 

1384 12 1:5 346 CMPRSS2 : CMPRSS2ST 

1385 12 1:5 346 END! 

1386 12 1:4 380 END; 

1387 12 113 387 WRITELN (LISTFILE* CR, CR »CR, OPTOTAL: 20 » • TOTAL OPERATORS' ) 5 
1383 12 1:3 466 WRl TELN ( CR , CR, CR t OPTOTAL : 20 , • TOTAL OPERATORS' ) ; 

1389 12 1:2 545 END? 

1390 12 1:0 545 END; 

1391 12 1:0 564 

1392 12 i:D 1 SEGMENT PROCEDURE DATACOUNT 



133 5 


13 


1 


: j 


1 


type 


ACTPTR^ACTREC; 


1394 


13 


1 


: t j 


1 




actrec=record 


1335 


13 


1 


:d 


X 




offset, totai_:integer; 


1396 


13 


1 


: j 


1 




les,gtr:actptr 


1397 


13 


1 


:o 


1 




END; 


1398 


13 


1 


:o 


1 


VAR 


total:integer; 


1399 


13 


1 


:d 


2 




heap:~integer; 


l<+00 


13 


1 


:d 


3 




treetrunk, entry: ac tptr; 


1401 


13 


1 


:d 


5 




filename:string; 


1402 


13 


1 


:d 


46 






1403 


13 


2 


:d 


1 


PROCEDURE SETORDER! 


1404 


13 


2 


:d 


1 


VAR 


INDEx:INTEGER! 


1405 


13 


2 


:o 


2 






1406 


13 


3 


ID 


1 


PROCEDURE dataset(Treemark:actptr) 5 


1407 


13 


3 


50 





BEGIN 


1408 


13 


3 


:o 





CSR-3 


1409 


13 


3 


51 





IF 


DSSTART^C INDEXKTREEMARK*. total then 


1410 


13 


3 


!2 


12 




if treemark*.les<>nil then 


1411 


13 


3 


!3 


18 




DATASETtTREEMARK^.LES) 


1412 


13 


3 


:2 


20 




ELSE 


1413 


13 


3 


13 


24 




BEGIN 


1414 


13 


3 


14 


24 




new(entry); 


1415 


13 


3 


!4 


30 




entry*. offset:=index; 


1416 


13 


3 


!4 


39 




entry a . total :=dsstart~c index i; 


1417 


13 


3 


!4 


50 




ENTRY*. LES:=NIL; 


1418 


13 


3 


54 


57 




entry*. gtr:=nilj 


1419 


13 


3 


14 


64 




treemark*.les:=entry; 


1420 


13 


3 


13 


71 




end 


1421 


13 


3 


:i 


71 


ELSE IF TREEMARK*.GTR<>NIL THEN 


1422 


13 


3 


13 


79 




DATASETtTREEMARK^.GTR) 


1423 


13 


3 


12 


81 




ELSE 


1424 


13 


3 


13 


85 




BEGIN 


1425 


13 


3 


:<+ 


85 




NEW(ENTRY) 5 


1426 


13 


3 


!4 


91 




ENTRY*.OFFSET:=INDEX; 


1427 


13 


3 


14 


100 




entr y*. total :=dsstart*c index h 


1428 


13 


3 


14 


111 




ENTRY". LES:=fJIL; 


1429 


13 


3! 


4 


118 




entry*. gtr:=nil; 


1430 


13 


3. 


4 


125 




treemark*.gtr:=entry; 


1431 


13 


3! 


3 


132 




END; 


1432 


13 


31 


5 


132 


LSR+1 


1433 


13 


3! 





132 


end; 
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13 


i:o 


144 
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13 


2:0 





1436 


13 


2:1 


Q 


1137 


13 
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6 


1138 


13 


2:1 


11 


1439 


13 


2:1 


18 


1410 


13 


2:1 


25 


1441 


13 


2:1 


31 


1442 


13 


2:1 


31 


1443 


13 


2:2 


31 


1444 


13 


2:2 


53 


1445 


13 


2:3 


62 


1446 


13 


2:4 


62 


1447 


13 


2:4 


67 


1448 


13 


2:4 


77 


1449 


13 


2:3 


83 


1450 


13 


2:3 


83 


1451 


13 


2:1 


83 


1452 


13 


2:0 


89 


1453 


13 


2:0 


104 


1454 


13 


4:d 


1 


1455 


13 


4:d 


2 


1456 


13 


4:0 





1457 


13 


4:1 





1458 


13 


4:1 


85 


1459 


13 


4:1 


143 


1460 


13 


4:1 


181 


1461 


13 


4:1 


223 


1462 


13 


4:1 


260 


1463 


13 


4:0 


302 


1464 


13 


4:0 


316 


1465 


13 


5:d 


1 


1466 


13 


5:0 





1467 


13 


5:1 





1468 


13 


5:1 


10 


1469 


13 


5:1 


15 


1470 


13 


5:2 


18 


1471 


13 


5:1 


69 


1472 


13 


5:0 


79 


1473 


13 


5:0 


92 


1474 


13 


1:0 






3 EG IN 

NErf(TREETRUNK) 5 

treetrunk~.total:=o; 
treetrunk*.les:=nil; 
treetrunk a .gtr:=nil; 
dataref:=o; index:=o; 
repeat 

csr-j 

inqex: = index + scan((datasegsize-indexi*2iochr(0)idsstart'»cindex3) div 2? 

IF DSSTART /V CINDEX3>0 THEN 
BEGIN 

qataset(treetrunk); 
dataref:=dataref + dsstart~cindex:i; 
osstart^cindex3:=o; 

ENq; 
CSR + U 

until index>=datasegsize; 

end; 

PROCEDURE DATAHEADER(VAR H2: INTERACTIVE ) 5 

VAR I : INTEGER I 

BEGIN 

WRITELN(H2,CRtCR»»DATA SEGMENT SIZE: • .DATASEGSIZE:6t * DATA REFERENCES: ' 1 

DATAREF:6t» LEX LEVEL » »PR0CLEXCDATAPR0C3:6) » 

WRITE<H2tCR,CR»»F0R SEGMENT •}; 

FOR i:=i TO 8 DO WRITE(H2»CHR<SEGDIRECC63 + DATASEG*8 +13) ){ 

WRITELN(H2,» PROCEDURE #• .DATAPROC : 3) ; 

WRITELN(H2«*0FFSET(W0RD) TOTAL XMi 
END! 

PROCEDURE PRINTDATA(TREE:ACTPTR) ; 
BEGIN 

IF TREE A .GTRONIL THEN PRINTDATA ( TREE~.GTR ) ; 

total:=tree a . TOTAL; 

IF DISPLAY THEN WRITELN (LISTFILE t 

TREE' v .OFFSET:9.TOTAL:il«TOTAL/DATAREF*100:9:2) ! 
IF TREE^.LESONIL THEN PRINTDATA(TREE^.LES) ; 

end; 

begin (* datacount *) ; 



1475 13 111 MARK(HrAP); 

1476 13 i:i 4 PAGE(OJTPUT) ; 

1477 13 l:i 1H GOTOXY(O.IO) 5 

I 1 "!" Ill J? ^•CHR(7,..0UTPUT FILE FOR O.T. SEG«NT STATISTieS,<CR> FOR NONEl: •>, 

1430 13 1:1 11& DISPLAy:=(FILENAME<>»«)} 

1431 i3 1:1 i2b console:=(filename=»console:») or <filename='«i:'>- 

1432 13 1:1 153 IF DISPLAY AND (FILENAMEOLASTFILENAME) THEN 

1433 13 1:2 164 BEGIN 

1434 13 1:3 164 CLOSE(LISTFILE,LOCK)5 

1435 lo 1:3 173 REWRITE(LISTFILE. FILENAME) ; 

1436 13 1:3 135 LASTFILENAME:=FILENAME5 
1487 13 1:2 192 END; 

1438 13 111 192 PAGE(OUTPUT) ; 

1469 13 i:i 202 SETORDER! 

1490 13 i:i 204 IF DISPLAY THEN DATAHEADER ( LlSTFlLE ) I 

1491 13 111 212 IF DATAREF>0 THEN 

1492 13 1:2 213 PRINTDATA(TREETRUNK^.GTR) 

1493 13 i:i 220 ELSE 

1494 13 i:2 224 BEGIN 

1495 13 1:3 224 IF DISPLAY THEN WRITELN ( LISTFILE t CR , CR , 

x ll° l l 1: * 2 ^ 'SORRY BUT THERE WERE NO ACCESSES'* 

1498 13 l\l fU END; ' ^ ™ IS ^^ SEGMENT FR0M DIS-ASSEMBLED PROCEDURES'); 

1499 13 111 362 PROMPT; 

1500 13 i:i 365 RELEASE(HEAP) 5 
1301 13 1:0 369 END; 

1502 13 l:o 386 

1503 1 2ID 1 PROCEDURE PROMPT; 

1504 1 2:u 1 v ar ch:char; 

1505 1 2:0 p.EGIN 

"OS 1 2:1 WRITE(CHR(7), CR.CR, 'PRESS SPACEBAR TO CONTINUE. ..»)! 

"°7 1 2:i 71 REPEAT READ(CH) UNTIL CH=» •; 

1503 1 2:i 66 WRITELJ; 

150 9 1 2: 1) 94 end; 

151 J 1 2:) 108 

1511 1 2:0 103 (*$I DISASi J 12,TEXT*) 

I 3 1 2 i 2 : J 1 "> 3 

1513 1 1:0 tfEGIN(*MAlN STUFT*) 

1514 1 1:1 rj INIT; 

1515 1 ji:i ci disassemble; 305 



u 



06 



1516 


1 


1:1 


lbi7 


1 


1:1 
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1 


1:1 


15x9 


1 


i:o 



32 IF QATA.'.ATCH THEN DmTACQUNT; 

49 GATHER; 

42 IF (LASTFlLtNAMEO* • ) AND MOT CONSOLE THEN CLOSE < LISTFILE . LOCK ) 

6b END. 



